معادلة ايجاد كل القيم التي تخص رقم معين

[romadream]

السلام عليكم ورحمه الله

 Vlookupخواني : هل من الممكن استخدام معادلة 

علشان اعمل ادراج لجميع القيم الخاصة بالمتغير ال عايز ابحث عنه  زي ماموجوده في الاكسل  المرفق؟

ارجو المساعد والشرح ازاي اطلع القيم الخاصة بالمتغير

وشكرا مقدما جدا

 

فولك اب.xlsx

[Ali Mohamed Ali]

وعليكم السلام -اهلا بك في المنتدى

بالتأكيد لا يمكن عمل هذا بمعادلة Vlookup - ولكن يمكن بمعادلات المصفوفة كما بالملف 

وتم عمل اكثر من المطلوب شوف بنفسك

 

 

ايجاد كل القيم التى تخص رقم معين.xlsx

[romadream]

شكرا جدا لحضرتك بجد عمل رائع فعلا

[سليم حاصبيا]

رائع استاذ علي ومعادلات رائعة ايضاً

لكن اسمح لي ان اضيف كود لهذا الغرض لعل فيه افادة لمن يريد التعمق اكثر في عالم الــ Diuctionary من خلال الــــ  VBA

Option Explicit
Sub Get_Phone()
Rem  ====>> Created By Salim Hasbaya On 18/7/2019
Application.ScreenUpdating = False
Dim Dict As Object
Dim Salim As Worksheet
Dim Itm, K, i%: i = 2
Dim My_Arr, M_key

 Set Dict = CreateObject("Scripting.Dictionary")
 Set Salim = Sheets("Salim")

 With Salim
      .Range("D2").CurrentRegion.Offset(1) _
      .Resize(, 10).ClearContents
     i = 2
    Do Until .Range("A" & i) = vbNullString
     K = .Range("A" & i): Itm = .Range("B" & i)
        If Not Dict.Exists(K) Then
          Dict.Add K, Itm
         Else
           Dict(K) = Dict(K) & ";" & Itm
         End If
       i = i + 1
     Loop
    '========================================
    i = 2
    With Dict
         For Each M_key In .keys
            Range("D" & i) = M_key
             My_Arr = Split(.Item(M_key), ";")
                If UBound(My_Arr) = 0 Then
                  Range("E" & i) = .Item(M_key)
                Else
                  Range("E" & i).Resize(, UBound(My_Arr)) = My_Arr
                End If
             i = i + 1
         Next
    End With
    '========================
    .Range("D2").CurrentRegion.Value = _
    .Range("D2").CurrentRegion.Value
  End With
  Dict.RemoveAll: Set Dict = Nothing
  Salim.Columns("E:H").AutoFit
  
  Application.ScreenUpdating = True
End Sub

الملف مرفق

 

FIND_PHONE.xlsm

[romadream]

عمل رائع وجزاك الله خير بس لما بجرب على ملف بيديني تكرار واحد بس ما بيجبش كل ال متكرر لنفس الرقم ممكن حل او تعديل لو سمحت

 

[سليم حاصبيا]

لا يجب ان يكون هناك فراغات في الجدول الاساسي

[romadream]

جزاك الله خير
مرفق لحضرتك نموذج انو مش بيجيب كل التكرار ارجو تعديل الكود

وجزاك الله خير لو في طريقة للتواصل مع حضرتك اكون شاكر جدا

FIND_PHONE.xlsm

تم تعديل أغسطس 15, 2019 بواسطه romadream

[romadream]

السلام عليكم ورحمه الله
ارجو التعديل على الكود المرفق حيث أنه يعمل على البحث عن القيم الخاصة برقم معين

ولكن يبحث عن كل القيم ماعدا اخر قيمه كما هو موضح بالأكسل المرفق

والكود عمل الأخ الفاضل / سليم حاصبيا 

جزاه الله خير الجزاء

FIND_PHONE.xlsm

[سليم حاصبيا]

تعديل بسيط على هذا السطر في الكود

 Range("E" & i).Resize(, UBound(My_Arr)) = My_Arr

ليصبح هكذا (زيادة واحد فقط)

 Range("E" & i).Resize(, UBound(My_Arr) + 1) = My_Arr

 

[وجيه شرف الدين]

ما شاء الله عليك استاذ سليم عمل رائع

[سليم حاصبيا]

تمت الاجابة على هذا العنوان

https://www.officena.net/ib/topic/92726-معادلة-ايجاد-كل-القيم-التي-تخص-رقم-معين/?tab=comments#comment-583693

 

[romadream]

جزاك الله خير الجزاء
وارجو التواصل مع حضرتك

[romadream]

ماشاء الله عمل أكثر من رائع وبجد جزاك الله خير
وشكرا جدا على سرعه الاستجابه

[وجيه شرف الدين]

بعد اذن استاذنا الحبيب استاذ سليم واثراء للموضوع

نسخة من FIND_PHONE-1.xlsm

[وجيه شرف الدين]

استاذى الحبيب استاذ سليم كل عام وانتم بخير وجزاكم الله عنا خير الجزاء

[سليم حاصبيا]

وانتم بخير صديقي وجيه

اعاده الله عليكم وعلى الامة العربية بالخير واليمن والبركات

[romadream]

كنت حابب اتواصل مع حضرتك يا استاذ سليم 
عايز اعمل كود بحث وحابب مساعده حضرتك 
لو عندي ارقام ببحث عنها على موقع على النت وعايز اعمل حاجه اتوماتك تبحث عن الارقام دي وتجبلي نتيجه البحث في شيت الاكسل
لو تقدر تساعدني في عمل كود زي كده اكون شاكر لحضرتك جدا ولو بمقابل مادي وجزاك الله خير

 

[سليم حاصبيا]

أسف ليس لدي الخبرة الكافية للبحث في النت من خلال الـــ Vba فهذا ليس من اختصاصي

يمكنك الاستعانة بخاصية البحث في Google لايجاد هكذا اكواد