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