طريقة إظهار أكثر من نتيجة عند استخدام vlookup

[خالد عبدالجواد]

check.xlsx

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

ربما كان المطلوب

 

check_Salim.xlsx

[خالد عبدالجواد]

جزاكم الله خيرا هدا ما اريده ولكن لا اريد ان اختار من قائمه اريد ان يكون عمود SerialNo1 بالكامل  امامه جميع نتائج call code

[خالد عبدالجواد]

check_Salim.xlsx 

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

ممكن عمل هذا

لكن المشكلة أن  البيانات كبيرة جداً (حواليي 5000 صف)مما يستغرق وقتاً كبيراً (حوالي 20 ثانية  لتنفيد هذه المعادلات مع أي تغيير يطرأ في اي خلية من الصغحة)

  ( 5000 × 5 أعمدة =25000 معادلة)   بالاضافة إلى تكبير حجم الملف إلى حوالي 1 Mega

لذلك طريقة العمل باستخدام كود برمجي يكون أفضل

انا قمت بالحل عن طريق النعادلات وهذه النتيجة

check_Salim1.xlsx

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

ممكن تجرب هذا الملف

الكود

Option Explicit

Sub Give_Uniques()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With
With salim
Dim m%: m = 3: Dim Col%: Col = 5
Dim R%, T%
Dim Cel As Range, S_RG As Range
Dim Find_RG As Range, A_RG As Range
 .Range("D3").CurrentRegion.ClearContents
 Set A_RG = .Range("A3").CurrentRegion.Columns(1)
 .Range("D3").Resize(A_RG.Rows.Count).Value = _
 A_RG.Value

 .Range("D3").CurrentRegion.RemoveDuplicates 1, 0

  Set S_RG = .Range("D3").CurrentRegion.Columns(1)
 For Each Cel In S_RG.Cells
  Set Find_RG = A_RG.Find(Cel, after:=A_RG.Cells(A_RG.Rows.Count))
   R = Find_RG.Row: T = R
     Do
        .Cells(m, Col) = .Cells(R, 2): Col = Col + 1
        Set Find_RG = A_RG.FindNext(Find_RG)
        R = Find_RG.Row
        If R = T Then Exit Do
     Loop
     m = m + 1: Col = 5
   Next
End With
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
End With
End Sub

الملف مرفق (فقط 90 كيلوبايت)

 

check_salim.xlsm

[خالد عبدالجواد]

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

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

1 ساعه مضت, khaled abdelgawad said:

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

الكود يعمل حتى اخر صف في العمود الأول مهما يكن عددها   شرط الا يكون خلايا فارغة بين الصفوف

[خالد عبدالجواد]

جزاكم الله خيرا هدا ما اريده ولكن تظهر لي هذه الرساله 

[خالد عبدالجواد]

هل هناك معادله تقوم بهذا الحل بدل من الكود ؟

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

12 دقائق مضت, khaled abdelgawad said:

هل هناك معادله تقوم بهذا الحل بدل من الكود ؟

استبدل هذه الاسطر من الكود 

Dim m%: m = 3: Dim Col%: Col = 5
Dim R%, T%

بهذه

Dim m as Long: m = 3: Dim Col as Long: Col = 5
Dim R as Long, T as Long

لقد وضعت لك طريقة بواسطة المعادلات في مشاركة سابقة (في هذا الملف) 

لكن المشكلة أن  البيانات كبيرة جداً (حواليي 5000 صف)مما يستغرق وقتاً كبيراً

check_Salim1.xlsx

 

[خالد عبدالجواد]

جزاكم الله خيرا شكرا جدا ع تعبك