ابو العلاء قام بنشر فبراير 11, 2020 مشاركة قام بنشر فبراير 11, 2020 السلام عليكم احتاج الى تحويل المعادلات بالخلايا باللون الاصفر الى اكود ستكرر هذه المعادلة الى نهاية الشيت في العمودين TESSST.rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر فبراير 11, 2020 أفضل إجابة مشاركة قام بنشر فبراير 11, 2020 جرب هذا الكود Option Explicit Sub test_me() Dim Sh As Worksheet, D As Worksheet Dim first#, last#, i#, Ro# Dim my_rg As Range, find_rg As Range Dim adres#, Obj As Object Set Sh = Sheets("Sheet1"): Set D = Sheets("DATA") Set Obj = CreateObject("System.collections.arraylist") Ro = Sh.Cells(Rows.Count, 1).End(3).Row adres = [TELE].Offset(, -1).Find("").Row Set my_rg = D.Range("B2").Resize(adres - 2) For i = 5 To Ro Set find_rg = my_rg.Find(Sh.Range("A" & i).Value, lookat:=1) If Not find_rg Is Nothing Then first = find_rg.Row: last = first Do Obj.Add D.Range("C" & last).Value Set find_rg = my_rg.FindNext(find_rg) last = find_rg.Row If last = first Then Exit Do Loop End If ' Obj.Sort Sh.Range("C" & i) = Obj(Obj.Count - 1) Obj.Clear Next End Sub الملف مرفق Abu_Alaa.xlsm 2 رابط هذا التعليق شارك More sharing options...
ابو العلاء قام بنشر فبراير 11, 2020 الكاتب مشاركة قام بنشر فبراير 11, 2020 كل الشكر استاذ سليم .... كالعادة قمة الدعم والمساعدة 1 رابط هذا التعليق شارك 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.