ابو هاله النبلسي قام بنشر يناير 7, 2023 مشاركة قام بنشر يناير 7, 2023 (معدل) السلام عليكم ورحمة الله وبركاته في المرفق باستخدام دالة VLOOKUP تم جلب البيانات حسب الدالة بالضبط باللون الاصفر لكن احتاجها عن طريق الVBA في حقل النتيجة باللون الاخضر وشكرا لكم مع فائق الاحترام نسخة من officene.xlsm تم تعديل يناير 7, 2023 بواسطه ابو هاله النبلسي رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يناير 7, 2023 مشاركة قام بنشر يناير 7, 2023 وعليكم السلام ورحمة الله تعالى وبركاته تفضل اخي نسخة من officene.xlsm 1 1 رابط هذا التعليق شارك More sharing options...
ابو هاله النبلسي قام بنشر يناير 7, 2023 الكاتب مشاركة قام بنشر يناير 7, 2023 كل التوفيق عمل راقي جدا حاب اطمع بكرم حضرتك ممكن يكون ديناميكي بامكان 40000 سجل ممكن لو تفضلت رابط هذا التعليق شارك More sharing options...
ابو هاله النبلسي قام بنشر يناير 7, 2023 الكاتب مشاركة قام بنشر يناير 7, 2023 السلام عليكم ورحمة الله وبركاته بعد التحية ... كيف يتم اعتماد VLOOKUP عن طريق VBA حسب المرفق والجدول انا عملت بالدالة لكن احتاجه بالVBA ياريت يكون الحل ديناميكي عند اضافة حقول يتم اعتمادها بعد تنفيذ الكود نسخة من نسخة من officene (2).xlsm رابط هذا التعليق شارك More sharing options...
ابو هاله النبلسي قام بنشر يناير 7, 2023 الكاتب مشاركة قام بنشر يناير 7, 2023 السلام عليكم ورحمة الله وبركاته بعد التحية ... كيف يتم اعتماد VLOOKUP عن طريق VBA حسب المرفق والجدول انا عملت بالدالة لكن احتاجه بالVBA ياريت يكون الحل ديناميكي عند اضافة حقول يتم اعتمادها بعد تنفيذ الكود نسخة من نسخة من officene (2).xlsm رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يناير 7, 2023 مشاركة قام بنشر يناير 7, 2023 2 ساعات مضت, ابو هاله النبلسي said: ياريت يكون الحل ديناميكي عند اضافة حقول يتم اعتمادها بعد تنفيذ الكود لا يمكنني تخمين موضع الحقول التي سيتم اظافتها يمكنك تعديله بنفس الطريقة عند اظافة حقول جديدة Sub TEST_MH2() Dim MT As Worksheet Dim lr As Long Set MT = Worksheets("sheet4") Application.ScreenUpdating = False lr = MT.Range("A" & Rows.Count).End(xlUp).Row MT.Range("F2:i" & lr).ClearContents With MT.Range("F2:F" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,1,0)" .Value = .Value With MT.Range("G2:G" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,2,0)" .Value = .Value With MT.Range("H2:H" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,3,0)" .Value = .Value With MT.Range("I2:I" & lr) .Formula = "=VLOOKUP(""*""&E2&""*"",A:D,4,0)" .Value = .Value End With End With End With End With Application.ScreenUpdating = True End Sub نسخة من نسخة officene _2.xlsm 2 1 رابط هذا التعليق شارك More sharing options...
ابو هاله النبلسي قام بنشر يناير 7, 2023 الكاتب مشاركة قام بنشر يناير 7, 2023 احسنت وبارك الله فيك عاشت الايادي رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يناير 7, 2023 مشاركة قام بنشر يناير 7, 2023 (معدل) العفو اخي الفاضل لقد حاولت تبسيط الكود الاول ليتم فهمه ربما تحتاج يوما ما للتعديل تفضل اخي اليك كود اخر يقوم بنفس المهمة لاكن حاول تجنب وضع علامة / بين الكلمات يمكنك استبدالها ب علامة (-) مثلا وسوف يشتغل معك الكود بكفاءة عالية بالتوفيق Sub Test_MH3() Dim a, b Dim I As Long, II As Long, LR As Long Dim j As Integer Dim ObjDic As Object Set ObjDic = CreateObject("Scripting.Dictionary") Dim K, T LR = Cells(Rows.Count, "A").End(3).Row a = Range("A2:D" & LR) For I = LBound(a, 1) To UBound(a, 1) ObjDic(a(I, 1)) = a(I, 2) & "/" & a(I, 3) & "/" & a(I, 4) Next I LR = Cells(Rows.Count, "e").End(3).Row b = Range("E2:E" & LR) ReDim Preserve b(LBound(b, 1) To UBound(b, 1), 1 To 5) For I = LBound(b, 1) To UBound(b, 1) For Each K In ObjDic.keys If K Like "*" & b(I, 1) & "*" Then T = Split(ObjDic(K), "/") b(I, 1) = K For II = 0 To UBound(T, 1) b(I, 2 + II) = T(II) Next II Exit For End If Next K Next I Cells(2, "F").Resize(UBound(b, 1), 4) = b End Sub نسخة من نسخة officene _3.xlsm تم تعديل يناير 7, 2023 بواسطه Mohamed Hicham 1 3 رابط هذا التعليق شارك More sharing options...
وليد المصرى 1 قام بنشر يناير 8, 2023 مشاركة قام بنشر يناير 8, 2023 استاذ محمد جزاك الله خير ولكن لو ان الكود بياخد البيانات من شيت اخر وليس من نفس الشيت ماذا يكون الكود ؟ رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يناير 8, 2023 مشاركة قام بنشر يناير 8, 2023 (معدل) تفضل اخي هذا مثال لطلبك Sub TEST_mh5() Dim ws As Worksheet Dim LR As Long Set ws = Worksheets("sheet2") Application.ScreenUpdating = False LR = ws.Range("B" & Rows.Count).End(xlUp).Row With ws.Range("c2:c" & LR) .Formula = "=VLOOKUP(""*""&b2&""*"",sheet1!A:E,1,0)" .Value = .Value With ws.Range("d2:d" & LR) .Formula = "=VLOOKUP(""*""&b2&""*"",sheet1!A:E,2,0)" .Value = .Value With ws.Range("E2:E" & LR) .Formula = "=VLOOKUP(""*""&b2&""*"",sheet1!A:E,3,0)" .Value = .Value With ws.Range("F2:F" & LR) .Formula = "=VLOOKUP(""*""&b2&""*"",sheet1!A:E,4,0)" .Value = .Value With ws.Range("G2:G" & LR) .Formula = "=VLOOKUP(""*""&b2&""*"",sheet1!A:E,5,0)" .Value = .Value End With End With End With End With End With End Sub جلب البيانات 2.xlsm تم تعديل يناير 8, 2023 بواسطه Mohamed Hicham 1 2 رابط هذا التعليق شارك More sharing options...
YOUCEF - 41 قام بنشر يناير 8, 2023 مشاركة قام بنشر يناير 8, 2023 بارك الله فيكم يا اساتذتنا الكرام رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يناير 8, 2023 مشاركة قام بنشر يناير 8, 2023 وفي حالة وضع شرط لو الخلية فارغة يمكنك جعل الكود كالتالي With ws.Range("c2:c" & LR) .Formula = "=IF(B2="""","""",VLOOKUP(""*""&B2&""*"",sheet1!A:E,1,0))" .Value = .Value 1 رابط هذا التعليق شارك More sharing options...
وليد المصرى 1 قام بنشر يناير 9, 2023 مشاركة قام بنشر يناير 9, 2023 بارك الله فيك اخى محمد مممكن يكون الكود اتوماتيك بدون اضافة زر رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان