الترحيل الى الصفوف بشرط خلية معينة

[Ali994m]

السلام عليكم

أرجو المساعدة في تعديل كود الترحيل ليتم الترحيل الى الصفوف التي تساوي خلية العمود F   مع ال Date TEXTBox

وجزاكم الله كل خير

 

ppp.xlsm

[أ / محمد صالح]

الملف به كود يقوم بالترحيل إلى أول صف فارغ بعد المكتوب في شيت micro وشيت raw

هل المطلوب تعديل الترحيل في شيت micro فقط إذا تساوى التاريخ في العمود f مع مربع نص التاريخ؟ مع الترحيل إلى آخر صف في شيت raw

أم أنه لا يتم الترحيل في الاثنين إلا إذا تساوى التاريخ؟

[Ali994m]

المطلوب أن يتم الترحيل على الى الصفوف في الشيت RAW & Micro اذا كانت خلية  F الصف في احدى أو كلتا الشيتات تساوي قيمة ال TEXTBOX

دون الترحيل الى اخر صف وجزاكم الله كل خير

[أ / محمد صالح]

اقتباس

المطلوب أن يتم الترحيل على الى الصفوف في الشيت RAW & Micro اذا كانت خلية  F الصف في احدى أو كلتا الشيتات تساوي قيمة ال TEXTBOX

المطلوب غير واضح لي

هل تقصد:

إذا تساوت قيمة خلية في العمود f في الشيت micro يتم الترحيل في نفس الصف الذي تساوت فيه (طبعا في شيت micro) ولا يقوم بالترحيل في شيت raw

وإذا تساوت قيمة خلية في العمود f في الشيت raw يتم الترحيل في نفس الصف الذي تساوت فيه ولا يقوم بالترحيل في شيت micro

؟؟؟

[Ali994m]

يتم الترحيل الى جميع الصفوف في الشيت raw و micro  التي تساوي قيمة العمود Date قيمة ال Textbox

[Ali994m]

الهدف الكلي من الموضوع أني أقوم باضافة بيانات على عالشيت raw و micro على مدار اليوم بشكل متكرر من خلال فورم اخر 

في اخر اليوم أريد اضافة بيانات أخرى على نفس الصفوف من خلال هذا الفورم 

وذلك من خلال اختيار تاريخ اليوم وجزاك الله كل خير

[أ / محمد صالح]

حسب فهمي للمطلوب 

أنك تريد تعديل جميع الصفوف التي يتساوى فيها عمود التاريخ مع التاريخ المكتوب في مربع النص

مرة في شيت micro

ومرة في شيت raw

لذلك جرب تعديل كود زر الأمر إلى ما يلي:

Private Sub CommandButton1_Click()
Dim ws As Worksheet, we As Worksheet, lr As Long, iRow As Long, n As Long, k As Integer, m As Integer

Set ws = Worksheets("micro")
lr = ws.Cells(Rows.Count, 6).End(xlUp).row
For n = 1 To lr
If ws.Cells(n, 6).Value = CDate(Me.TextBox16.Value) Then
ws.Cells(n, 13).Value = Me.TextBox10.Value
ws.Cells(n, 14).Value = Me.TextBox11.Value
ws.Cells(n, 15).Value = Me.TextBox12.Value
ws.Cells(n, 16).Value = Me.TextBox13.Value
ws.Cells(n, 17).Value = Me.TextBox14.Value
ws.Cells(n, 18).Value = Me.TextBox15.Value
For k = o To ListBox2.ListCount
     If ListBox2.Selected(k) = True Then
        ws.Cells(n, 11).Value = ListBox2.List(k, 0)
        Exit For
On Error Resume Next
End If
Next k
End If
Next n

Set we = Worksheets("Raw")
iRow = we.Cells(Rows.Count, 6).End(xlUp).Offset(1, 0).row
For m = 1 To iRow
If we.Cells(m, 6).Value = CDate(Me.TextBox16.Value) Then
we.Cells(m, 16).Value = Me.TextBox10.Value
we.Cells(m, 17).Value = Me.TextBox11.Value
we.Cells(m, 18).Value = Me.TextBox12.Value
we.Cells(m, 19).Value = Me.TextBox13.Value
we.Cells(m, 20).Value = Me.TextBox14.Value
we.Cells(m, 21).Value = Me.TextBox15.Value
For k = o To ListBox2.ListCount
    If ListBox2.Selected(k) = True Then
       we.Cells(m, 11).Value = ListBox2.List(k, 0)
       Exit For
On Error Resume Next
End If
Next k
End If
Next m
      
End Sub

لاحظ استعمال حلقة تكرارية لكل خلايا العمود F ورقمه 6

واستعمال المتغير N & M للتعبير عن رقم الصف الذي تساوت فيه القيم

بالتوفيق

[Ali994m]

جزاك الله كل خير لكن الكود لم يعمل أخي ظهرت رسالة خطا كما في الصورة

وحتى بعد حذف جزء الكود الخاص بالصفحة الثانية وترك الجزء الخاص بالترحيل على الصفحة الأولى MICRO لم يعمل الكود

[Ali994m]

الملف

ppp.xlsm

[أ / محمد صالح]

احذف هذا السطر 

لأني قمت بالإعلان عن جميع المتغيرات في أول سطر

والرسالة تعني تكرار إعلان عن متغير 

بالتوفيق

[Ali994m]

كود رائع جزاك الله كل خير لكن الكود لايعمل الى مع الخلايا التي معرفها نص ولا يعمل مع الأرقام والتاريخ

[أ / محمد صالح]

شكرا لكلماتك الطيبة 

أنا شخصيا لم اغير إلا فيما يحقق الشرط الخاص بك

على اعتبار ان الكود يعمل معك قبل ذلك 

لذلك إذا كنت تقصد تحويل النص المكتوب في مربع النص إلى تاريخ يمكنك تعديل 

Me.TextBox16.Value

في الشرط إلى 

cdate(Me.TextBox16.Value) 

تم تعديل الكود كاملا في المشاركة الأصلية

بالتوفيق