أبو چيداء قام بنشر سبتمبر 29, 2014 قام بنشر سبتمبر 29, 2014 Set ws1 = Sheets("HR DB") Set ws2 = Sheets("3 Y History") Set ws3 = Sheets("Plan 2015") Dim arr() Me.TextBox2 = "" Me.TextBox4 = "" Me.TextBox5 = "" Me.TextBox7 = "" Me.TextBox8 = "" Me.TextBox9 = "" Me.TextBox10 = "" ListBox1.Clear ListBox2.Clear LR = ws1.Cells(Rows.Count, 1).End(xlUp).Row LR2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row LR3 = ws3.Cells(Rows.Count, 1).End(xlUp).Row Set Rng1 = ws1.range("A2:A" & LR) Set Rng2 = ws2.range("A2:A" & LR2) Set Rng3 = ws3.range("A2:A" & LR3) x = Val(Me.TextBox1) '======================================= On Error Resume Next For Each cl In Rng1 If cl = x Then Me.TextBox2 = cl.Offset(0, 1) Me.TextBox4 = cl.Offset(0, 3) Me.TextBox5 = cl.Offset(0, 2) Me.TextBox7 = cl.Offset(0, 4) Me.TextBox8 = cl.Offset(0, 5) Me.TextBox9 = cl.Offset(0, 6) Me.TextBox10 = Format(cl.Offset(0, 8), "# ") Exit For End If Next For Each clll In Rng3 If clll = x Then i = i + 1 ReDim Preserve arr(1 To 2, 1 To i) arr(1, i) = clll.Offset(0, 20) arr(1, i) = clll.Offset(0, 23) End If Next R = UBound(arr, 1): RR = UBound(arr, 2) Me.ListBox2.List = Application.WorksheetFunction.Transpose(arr) For Each cll In Rng2 If cll = x Then i = i + 1 ReDim Preserve arr(1 To 5, 1 To i) arr(1, i) = cll.Offset(0, 2) arr(2, i) = Format(cll.Offset(0, 3), "yyyy/mm/dd") arr(3, i) = Format(cll.Offset(0, 4), "yyyy/m/dd") arr(4, i) = cll.Offset(0, 5) arr(5, i) = Format(cll.Offset(0, 6), "0%") End If Next R = UBound(arr, 1): RR = UBound(arr, 2) Me.ListBox1.List = Application.WorksheetFunction.Transpose(arr) End Sub
ياسر خليل أبو البراء قام بنشر سبتمبر 29, 2014 قام بنشر سبتمبر 29, 2014 أخي الحبيب أبو جيداء يرجى إرفاق ملف أفضل حتى يتسنى للأعضاء فهم الكود والتعامل معه
أبو چيداء قام بنشر سبتمبر 29, 2014 الكاتب قام بنشر سبتمبر 29, 2014 اخى ياسر الكود يعمل جيدا ولكنى اضفت ليست بوكس 2 ليأخذ داتا من شيت اخر ولكنه ياخذ نفس الداتا من الشيت الاخر
ياسر خليل أبو البراء قام بنشر سبتمبر 29, 2014 قام بنشر سبتمبر 29, 2014 لي طلب آخر بسيط قم بنسخ الكود ووضعه في الكود بالشكل التالي حتى يسهل علينا متابعة أسطر الكود ضع الكود بهذا الشكل
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.