سليم حاصبيا

قم بتعديل الكود الى هذا الشكل Private Sub ComboBox1_Change() Dim ws As Worksheet, lr As Integer, i As Long, Col% Set ws = Sheets("feuil1") lr = Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To lr If ComboBox1.Text = Cells(i, 1) Then ws.Cells(i, 1).Activate Me.TextBox1.Value = Cells(i, 2) Me.TextBox2.Value = Cells(i, 3) Me.TextBox3.Value = Cells(i, 4) Me.TextBox4.Value = Cells(i, 5) Me.TextBox5.Value = Cells(i, 6) Col = Cells(i, Columns.Count).End(1).Column Me.TextBox7.Value = Cells(i, Col) End If Next End Sub

حرب هذا الكود مجرد ان تخرج من الصفحة ثم تعوداليها يقوم الكود بعمله Option Explicit Private lrc%, lrg%, My_St1$, My_St2$ Private Sub Worksheet_Activate() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Range("c2:c500").ClearContents Range("g2:g500").ClearContents lrc = Sheets("ورقة1").Cells(Rows.Count, "a").End(3).Row lrg = Sheets("ورقة1").Cells(Rows.Count, "e").End(3).Row My_St1 = "=COUNTIF($B$2:B2,B2)+RANK(B2,$B$2:$B$32)-1" My_St2 = "=VLOOKUP(E2,$A$2:$C$32,3,0)" auto_formula End Sub Sub auto_formula() Range("c2:c" & lrc).Formula = My_St1: Range("c2:c" & lrc).Value = Range("c2:c" & lrc).Value Range("g2:g" & lrg).Formula = My_St2: Range("g2:g" & lrg).Value = Range("g2:g" & lrg).Value Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

ساهد هذا الفيديو https://www.youtube.com/watch?v=L1lAF4Irqlk

لا اعلم ما السبب في الخلل عندك (مع ان الكودين يعملان بشكل ممتاز عندي)

الكود المطلوب Me.TextBox80.Value = Format(Evaluate("CEILING(" & Val(Me.Detels3) & ",0.05)"), "0.00") من مشاكل اللغة العربية ") الذي في البداية يجب ان يكون في نهاية السطر) عذرا لم اتمكن من رفع الكود بواسطة <> لبطء النت عندي الملف مرفق نتيجه salim.rar

ضع هذا الكود في جدث الورقة SS عذرا لم استطع رفع الكود بواسطة <> لبطء النت (Private Sub Worksheet_Change(ByVal Target As Range If Target.Address <> "$H$10" And Target.Count > 1 Then Exit Sub Sheets("DD").Range("D7").Value = Sheets("SS").Range("H10").Value End Sub

ارفع جزء من الملف للمعالجة

استيدل كلمة Round بكلمة Ceiling لتصيح المعادلة في الكود بهذا الشكل: Me.TextBox80.Value = Format(Ceiling(Val(Me.Detels3) * 6.5 / 1000, 0.05), "0.00")

جرب هذا الملف يمكن اضافة قدر ما تريد من اسماء الى الجدول (500 اسم ) الطلاب Salim.rar

يمكنك تجربة هذين الكودين مع بعض و عسى ان يكون المطلوب Option Explicit Private OldVal Private Sub Worksheet_Change(ByVal Target As Range) Dim x%, my_name$ On Error Resume Next If Target.Column = 3 And Target.Cells.Count = 1 Then my_name = Target.Value End If If OldVal = my_name Or Target.Value = "" Then Exit Sub Application.DisplayAlerts = False Sheets(OldVal).Delete Application.DisplayAlerts = True x = Len(Sheets(my_name).Name) If x = 0 Then Sheets("Sample").Copy after:=Sheets(Sheets.Count) ActiveSheet.Name = my_name End If On Error GoTo 0 End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lr As Integer If Target.Column = 3 And Target.Cells.Count = 1 Then OldVal = Target.Value End Sub

شرح الكود explain_code.rar

اضف هذه الفقرة الى الكود مباشرة بعد كلمة Next r Laste_Row = sh.Cells(Rows.Count, "AN").End(3).Row For i = 11 To Laste_Row + 1 Step 2 sh.Range("AN" & i).Resize(, 10).ClearContents Next

يمكن استعمال هذا الماكرو (الملف مرفق)صفحة salim Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim Arr Dim x%, n% Application.EnableEvents = False On Error Resume Next If Target.Column = 2 And Target.Row > 2 And Target.Cells.Count = 1 Then Arr = Array("X", "ص", "م", "ع", "ض") Application.AddCustomList ListArray:=Arr x = Application.Match(Target, Arr, 0) If x Then Target.Offset(0, 1) = Target Target.Offset(0, 1).AutoFill Target.Offset(0, 1).Resize(1, 23) Else MsgBox "Unvaliable Value": Target.Resize(, 24) = "" End If End If 1: n = Application.GetCustomListNum(Array("X", "ص", "م", "ع", "ض")) Application.DeleteCustomList n Application.EnableEvents = True End Sub عداد Salim WithVBA.rar

بعد اذن اخي الحبيب ياسر نفس الشيء بمعادلة واحدة توضع في الخلية C3 و تسحب يساراً ثم نزولاُ =IF($B3="","",IF(COLUMNS($A$1:A1)=1,B3,INDEX({"X";"ص";"م"},IF(MATCH(B3,{"X";"ص";"م"},0)=3,1,MATCH(B3,{"X";"ص";"م"},0)+1)))) الملف مرفق مع المعادلة المطلوبة عداد Salim.rar

جرب هذه المعادلة قي الخلية T11 واسحب نزولاُ =IF(C11="","",MOD((ROWS($A$1:A1)-1),COUNTIF($D$11:$D$600,"ذكر"))+1) او هذه ربما اكثر دقة في حال لم يكن الجدول مفروزاً =IF(C11="","",COUNTIF($D$11:D11,D11))

جرب هذا الكود و ضعه في حدث الصفحة(إضافة أسماء الطلاب) يمكن نسخه الى باقي الصقحات مع التعديل على رقم العامود المطلوب Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.EnableEvents = False If Target.Column = 13 And Target.Row >= 7 And Target.Cells.Count = 1 Then ActiveSheet.Columns("M").AutoFit End If Application.ScreenUpdating = True Application.EnableEvents = True End Sub

ارفع مثالاً عمل تريد مع النتائج المتوقعة و ما هي النتيجة اذا كانت خلية واحدة او اثنتين نساوي "غ"

لم افهم عليك ماذا تعني x - ص - م

استبدل الفاصلة "," بفاصلة منقوطة ";" في المعادلة أو العكس(حسب اعدادات الجهاز عندك ) لتصبح هكذا =IF(AND(A1="";F1="";I1="");"";ROUND(SUM(A1,F1,I1);1)) Ctrl+Shift+Enter و ليس Enter وحدها

ما هو رقم العامود حيث الاسماء

المعادلة تكتب كذا و لنتفيذها يجب الضغط على Ctrl+Shift+Enter و ليس Enter وحدها =IF(AND(A1="",F1="",I1=""),"",ROUND(SUM(A1,F1,I1),1))

بعد اذن اساتذتنا الكرام هذا الكود اسرع قليلاً و اخف وزناً Sub Salim() Sheets("sheet2").Range("a:a").Clear Range("Table1[[#All],[NUMBER]]").AdvancedFilter Action:=xlFilterInPlace, Unique:=True Range("Table1[[#All],[NUMBER]]").SpecialCells(12).Copy Sheets("Sheet2").Range("A1") Application.CutCopyMode = False Sheets("Sheet1").ShowAllData End Sub

ربما تستفيد من هذا الملف My_sum.rar

ارفع مثالاً صغيراً (10-20) صف عما تريد لان الشرح غير مفهوم

جرب هذا الكود Sub copy() Sheets("ورقة2").Range("b12").Resize(, 7).Value = _ Sheets("ورقة1").Range("B" & Rows.Count).End(xlUp).Rows.Resize(, 7).Value End Sub