أبو چيداء قام بنشر سبتمبر 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 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر سبتمبر 29, 2014 مشاركة قام بنشر سبتمبر 29, 2014 أخي الحبيب أبو جيداء يرجى إرفاق ملف أفضل حتى يتسنى للأعضاء فهم الكود والتعامل معه رابط هذا التعليق شارك More sharing options...
أبو چيداء قام بنشر سبتمبر 29, 2014 الكاتب مشاركة قام بنشر سبتمبر 29, 2014 اخى ياسر الكود يعمل جيدا ولكنى اضفت ليست بوكس 2 ليأخذ داتا من شيت اخر ولكنه ياخذ نفس الداتا من الشيت الاخر رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر سبتمبر 29, 2014 مشاركة قام بنشر سبتمبر 29, 2014 لي طلب آخر بسيط قم بنسخ الكود ووضعه في الكود بالشكل التالي حتى يسهل علينا متابعة أسطر الكود ضع الكود بهذا الشكل رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.