دالة iNDEX باستخدام الكود vba

[مستخدم الاوفس]

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

وفقكم الله لكل خير

انا لدي ورقة اكسل اسمها bASMMA فيها مجموعة بيانات مشتركة مع الورقة الثانية NASHER 

انا بحاجة الى جلب البيانات من الورقة NASHER ليقوم بوضعها في ورقة bASMMA استناداً الى الرقم والتاريخ

انا اقوم بالعملية من خلال دالة iNDEX احتاج الى العمل من خلال الكود

وفقكم الله 

المصنف1.xlsx

[عبدالله بشير عبدالله]

وعليكم السلام ورحمة الله وبركاته

جرب الملف واتمنى ان يكون طلبك

الكود للفاضل عبدالله باقشير حفظه الله واهلنا في اليمن

المصنف1.rar

[مستخدم الاوفس]

وفقك الله لكل خير لكن لدي بعضممكن اخي العزيز

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

Formula_To_Value Range("E2:E1000"), "=IF(RC[-3]="""","""",INDEX(NASHER!R2C6:R10C64,MATCH(RC[-4],NASHER!R2C1:R10C1,0),MATCH(BASMMA!RC[-1],NASHER!R1C6:R1C64,0)))"

هنا استخدم دالة INDEX لكن الصيغة غير مفهومة 

MATCH(RC[-4],NASHER!R2C1:R10C1,0)

انا غير وضحه لدية الصيغة بهذه الطريقه الى مذا تشير RC[-4] ممكن شرح بسيط

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

بعد اذن الاساتذة الكرام

هذا الماكرو

Option Explicit
Sub get_data()
Dim B As Worksheet: Set B = Sheets("BASMMA")
Dim N As Worksheet: Set N = Sheets("NASHER")
Dim Dic As New Dictionary
Dim i%: i = 2
Dim x

With N
  Do Until .Range("B" & i) = vbNullString
   If Not Dic.Exists(.Range("B" & i).Value) Then
    Dic.Add .Range("B" & i).Value, .Range("F" & i).Resize(, 59).Value
   End If
    i = i + 1
   Loop
  B.OLEObjects("Combobox1").Object.List = Dic.Keys
 End With
 x = N.Range("B:b").Find(B.Range("h2")).Row
 With B
 .Range("a2") = N.Cells(x, 1)
 .Range("b2") = N.Cells(x, 2)
 .Range("c2") = N.Cells(x, 4)
 .Range("e2").Resize(59, 1).Value = _
 Application.Transpose(Dic.Items(x - 2))
 End With
 Dic.RemoveAll
End Sub

الملف مرفق

 

Salim_Search.xlsm

[عبدالله بشير عبدالله]

Range("E2:E1000")

 

المدى او النطاق الذي سيطبق عليه الكود 

IF(RC[-3]="""",""""

اذا كان الاسم  فارعا  فتكون الخلية خالية

INDEX(NASHER!R2C6:R10C64

 هي نفسها   صفحة    NASHER    بداية من الصف الثاني R2العمود السادس C6الىالصف العاشرR10الغمود الرابع والستون C64

                                                                                                                                                    INDEX(NASHER!$F$2:$BL$10

MATCH(RC[-4],NASHER!R2C1:R10C1,0)

هي نفسها        اي 4- تعني الغمود A بمعنى الاعمدة التي قبل العمود E هي 4                                                                                                                                  

                                                                                                                                               MATCH(A2;NASHER!$A$2:$A$10;0)

MATCH(BASMMA!RC[-1],NASHER!R1C6:R1C64,0)))

هي نفسها 

                                                                                                                                MATCH(BASMMA!D2;NASHER!$F$1:$BL$1;0))                                                                                                                                     

اي الكود هو  نفسها المعادلة التى وضعتها انت  بل تم ترجمتهاالى كود

تحياتي

 

 

 

 

 

 

 

 

[مستخدم الاوفس]

وفقك الله لكل خير اخي العزيز شرح وافي

[مستخدم الاوفس]

اقتباس

وعليكم السلام ورحمة الله وبركاته

جرب الملف واتمنى ان يكون طلبك

الكود للفاضل عبدالله باقشير حفظه الله واهلنا في اليمن

السلام عليكم ورحمة الله وبركاته 

 

لدي فكرة جديد على المرفق وهي تحديد الورقة التي يقوم بجلب البيانات منها 

اي اقوم بالضغط على الخلية J1 يتم عرض اسماء الاوراق ويتم اختيار الورقة المناسبة 

مع العلم اني الجدول هو نفسة في كل الاوراق لكن البيانات تختلف (هيكلية الجدول ثابته في كل الاوراق)

وفقكم الله لكل خير 

 

المصنف1.rar

تم تعديل يونيو 11, 2019 بواسطه مستخدم الاوفس

[مستخدم الاوفس]

للرفع

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

‍جرب هذا الماكرو

Option Explicit
Sub get_data()
Dim B As Worksheet: Set B = Sheets("BASMMA")
Dim sh_name$: sh_name = B.Range("j1")
On Error Resume Next
 If Len(Sheets(sh_name).Name) = 0 Or sh_name = vbNullString Then Exit Sub
 On Error GoTo 0
Dim N As Worksheet: Set N = Sheets(sh_name)
Dim Dic As New Dictionary
Dim i%: i = 2
Dim x

With N
  Do Until .Range("B" & i) = vbNullString
   If Not Dic.Exists(.Range("B" & i).Value) Then
    Dic.Add .Range("B" & i).Value, .Range("F" & i).Resize(, 59).Value
   End If
    i = i + 1
   Loop
  B.OLEObjects("Combobox1").Object.List = Dic.Keys
 End With
 x = N.Range("B:b").Find(B.Range("h2")).Row
 With B
 .Range("a2") = N.Cells(x, 1)
 .Range("b2") = N.Cells(x, 2)
 .Range("c2") = N.Cells(x, 4)
 .Range("e2").Resize(59, 1).Value = _
 Application.Transpose(Dic.Items(x - 2))
 End With
 Dic.RemoveAll
End Sub

الملف مرفق

‌Salim_File.xlsm

[مستخدم الاوفس]

اقتباس

جرب هذا الماكرو

السلام عليكم اخي العزيز 

لدي تعديل هو ان لا احتاج ان اختار من كومبو بوكس اسم محدد 

ولا احتاج ان يظهر لي اصلا 

انا بحاجة الى جلب كافة البيانات من الورقة المختارة في القائمة 

وفقك الله لكل خير

 

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

3 ساعات مضت, مستخدم الاوفس said:

السلام عليكم اخي العزيز 

لدي تعديل هو ان لا احتاج ان اختار من كومبو بوكس اسم محدد 

ولا احتاج ان يظهر لي اصلا 

انا بحاجة الى جلب كافة البيانات من الورقة المختارة في القائمة 

وفقك الله لكل خير

 

لعمل ذلك هذا الماكرو

Option Explicit
Sub ALL_data()
Dim B As Worksheet: Set B = Sheets("SALIM")
Dim sh_name$: sh_name = B.Range("j1")
On Error Resume Next
 If Len(Sheets(sh_name).Name) = 0 Or sh_name = vbNullString Then Exit Sub
 On Error GoTo 0
Dim N As Worksheet: Set N = Sheets(sh_name)
Dim Dic As New Dictionary
Dim i%: i = 2
B.Range("a4").CurrentRegion.Clear
With N
    Do Until .Range("a" & i) = vbNullString
       Dic(i - 2) = .Range("a" & i).Resize(, 64)
        i = i + 1
   Loop
       
    For i = 0 To Dic.Count
       B.Range("a" & i + 5).Resize(, 64) = Dic.Item(i)
    Next
 End With
 With B.Range("a5").CurrentRegion
  .Interior.ColorIndex = 35
  .Borders.LineStyle = 1
  .InsertIndent 1
 End With
 N.Range("a1").Resize(, 64).Copy _
 B.Range("a4")
 Dic.RemoveAll
End Sub

الملف مرفق صفحة SALIM

 

 

_Salim_File_NEW.xlsm

[مستخدم الاوفس]

 

اقتباس

وعليكم السلام ورحمة الله وبركاته

جرب الملف واتمنى ان يكون طلبك

الكود للفاضل عبدالله باقشير حفظه الله واهلنا في اليمن

السلام عليكم ورحمة الله وبركاته

اخي العزيز هل بالامكان العديل على الكود بحيث يتلائم مع احتياحي 

بحيث اقوم بتحديد ورقة العمل التي اقوم بجلب البيانات منها اعتمادً على قائمة باسماء اوراق العمل موجودة في الخلية j1 فرضاً

هذا هو الكود في المثال الاول 

Sub Kh_Formula_To_Value()
Dim MyCalcu As XlCalculation
With Application
    MyCalcu = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With
    Sheets("BASMMA").Select
    Range("E2:E1000").Select
    Selection.ClearContents
Formula_To_Value Range("E2:E1000"), "=IF(RC[-3]="""","""",INDEX(NASHER!R2C6:R10C64,MATCH(RC[-4],NASHER!R2C1:R10C1,0),MATCH(BASMMA!RC[-1],NASHER!R1C6:R1C64,0)))"

With Application
    .ScreenUpdating = True
    .Calculation = MyCalcu
End With

End Sub

 

[مستخدم الاوفس]

للرفع

[مستخدم الاوفس]

السلام عليكم ورحمة الله وبركاته 

 

اخواني الاعزاء انا قمت بعرض الموضوع سابقاً في المشاركة على الرابط 

المشاركة السابقة

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

الكود 

التعديل هو ان الدالة index تعمل في السطر هنا على ورقة عمل اسمها NASHER وانا لدي اكثر من ورقة يجب اختيار واده منها

Formula_To_Value Range("E2:E1000"), "=IF(RC[-3]="""","""",INDEX(NASHER!R2C6:R10C64,MATCH(RC[-4],NASHER!R2C1:R10C1,0),MATCH(BASMMA!RC[-1],NASHER!R1C6:R1C64,0)))"

الحاجه هو انني عملت مثال ووضعت خلية J1 في ورقة Basmma تحوي على قائمة باسماء الاوراق المراد جلب البيانات منها 

اقوم بتحديد الورقة من القائمة فيعمل على تعديل السطر البرمجي وتغيير اسم الورقة فقط من NASHER الى اسم الورقة المختارة وم القائمة ويجلب البيانات منها

وفقكم الله لكل خير

[مستخدم الاوفس]

 

 

اخواني الاعزاء انا قمت بعرض الموضوع سابقاً في المشاركة على الرابط 

المشاركة السابقة

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

الكود 

التعديل هو ان الدالة index تعمل في السطر هنا على ورقة عمل اسمها NASHER وانا لدي اكثر من ورقة يجب اختيار واده منها

Formula_To_Value Range("E2:E1000"), "=IF(RC[-3]="""","""",INDEX(NASHER!R2C6:R10C64,MATCH(RC[-4],NASHER!R2C1:R10C1,0),MATCH(BASMMA!RC[-1],NASHER!R1C6:R1C64,0)))"

الحاجه هو انني عملت مثال ووضعت خلية J1 في ورقة Basmma تحوي على قائمة باسماء الاوراق المراد جلب البيانات منها 

اقوم بتحديد الورقة من القائمة فيعمل على تعديل السطر البرمجي وتغيير اسم الورقة فقط من NASHER الى اسم الورقة المختارة وم القائمة ويجلب البيانات منها

وفقكم الله لكل خير

 

•