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

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


إذهب إلى أفضل إجابة Solved by عبدالله الصاري,

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

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

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

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

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

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

وفقكم الله 

المصنف1.xlsx

رابط هذا التعليق
شارك

  • أفضل إجابة

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

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

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

المصنف1.rar

  • Like 1
رابط هذا التعليق
شارك

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

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

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

  • Like 3
رابط هذا التعليق
شارك

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))                                                                                                                                     

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

تحياتي

 

 

 

 

 

 

 

 

  • Like 1
رابط هذا التعليق
شارك

اقتباس

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

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

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

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

 

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

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

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

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

 

المصنف1.rar

تم تعديل بواسطه مستخدم الاوفس
رابط هذا التعليق
شارك

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

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

  • Like 1
رابط هذا التعليق
شارك

اقتباس

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

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

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

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

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

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

 

رابط هذا التعليق
شارك

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

  • Like 1
رابط هذا التعليق
شارك

  • 2 weeks later...

 

اقتباس

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

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

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

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

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

بحيث اقوم بتحديد ورقة العمل التي اقوم بجلب البيانات منها اعتمادً على قائمة باسماء اوراق العمل موجودة في الخلية 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 الى اسم الورقة المختارة وم القائمة ويجلب البيانات منها

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

 
  •  
رابط هذا التعليق
شارك

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