تم رفع هذا الكود فى مشاركة منفصله
حتى لا ننسى هذه المشاركة آن الأوان أن نتاكتف جميعاً من أجل بناء أكبر مكتبة أكواد عربية مشاركه من / ياسر خليل أبو البراء
تم ارفاق كود مشاركه من الفاضل/ يوسف عطا
وبعدها سنوات قام العملاق ياسر خليل أبو البراء بتنفيذ وعده
المشروع الكبير (مكتبة الصرح .. زاخرة بالشرح) وهي عبارة عن تجميع لمكتبة الأكواد
و لا تنسونا من صالح الدعاء
تحياتى
setupبرنامج اكواد .rar
الفكرة قريبة من الاولى ولكن هنا عملنا فلترة وفصل حسب النادي
لاحظ القيمة الافتراضية في الجدول فمنطقيا قد يكون النقص من اليمين او يكون من اليسار
لذا اي حقل فارغ ستظهر فيه العبارة الخاصة به
rs.MoveFirst
c1 = rs!club
For i = 1 To ii
If rs!club = c1 Then
rs2.AddNew
rs2!player1 = rs!player
rs2!pl1club = rs!club
rs2.Update
rs.MoveNext
Else
rs.MoveNext
End If
Next i
rs.MoveFirst
rs2.MoveFirst
For i2 = 1 To ii
If rs!club <> c1 Then
rs2.Edit
rs2!player2 = rs!player
rs2!pl2club = rs!club
rs2.Update
rs2.MoveNext
rs.MoveNext
Else
rs.MoveNext
End If
Next i2
Append5.rar
خطوات لازم تتعمل :
اولا هيكون عندك جدولين الجدول الاول فيه تاريخ الفاتورة ورقم الفاتورة وملاحظات مثلا والجدول الثانى فيه الاصناف الموجودة بالفاتورة والجدولين مرتبطين ببعض عن طريق رقم الفاتورة علاقة واحد الى متعدد او One To Many
ثانى خطوة هيكون عندك نموذجين واحد رئيسى والثانى فرعى بداخله... النموذج الاول هيكون مصدره الجدول الاول اللى يخص التاريخ ورقم الفاتورة والنموذج الفرعى هيكون مصدره الجدول الثانى اللى فيه الحركات
طبق الافكار ولو ظهرت مشاكل اعرصها بالتوفيق
جرب هذا الماكرو
Sub Talween()
Lr = Sheets("sheet1").Cells(Rows.Count, 3).End(3).Row
If Lr < 2 Then Lr = 2
Sheets("sheet1").Range("b2:b" & Lr).Interior.ColorIndex = 0
m = 2
For i = 2 To Lr
If IsNumeric(Range("c" & i)) Then
x = (Abs(Range("c" & i).Value) + 1) Mod 56 + 1
Range("b" & i).Interior.ColorIndex = x + m
End If
Next
End Sub