اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

  • أفضل إجابة
قام بنشر

جرب هذا  الكود

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

  • Like 2

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information