اذهب الي المحتوي
أوفيسنا

طلب مساعدة في دالة أو كود للبحث بعدة معاير في عدة شيتات في الملف


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

بسم الله الرحمن الرحيم 

السادة الأفاضل المحترمين ... مشرفين ... ورواد المنتدى المحترمين .

تحية طيبة من عند الله ... وبعد

برجاء مساعدتي في إيجاد دالة أو كود للبحث في عدة شيتات في الملف ويكون البحث أما ( بالاسم - أو الرقم القومي - أو رقم الجلوس ) أو الثلاثة معا .

ومرفق ملف للتوضبح وبه شرح المطلوب .

وجزاكم الله كل الخير .

البحث بعدة معايير.xlsx

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

حرب هذا الكود للبحث فن الاسم

(يمكنك عمل مثله للبحث عن الرقم القومي)

Option Explicit
Sub find_St()
Dim My_St$: My_St = Sheets("Home").Cells(2, "J")
Dim sh As Worksheet
Dim r%, n%, SH_name$
Dim find_rg As Range
Dim Adr$, col%: col = 2
Dim k%
Dim arr_even(1 To 13)
Dim arr_Odd(1 To 12)
Range("My_range") = vbNullString
'==========================================

  arr_even(1) = 4: arr_even(2) = 6: arr_even(3) = 8: arr_even(4) = 10
  arr_even(5) = 12: arr_even(6) = 14: arr_even(7) = 18: arr_even(8) = 20
  arr_even(9) = 16: arr_even(10) = 22: arr_even(11) = 24: arr_even(12) = 26
  arr_even(13) = 28
  For n = 1 To UBound(arr_even) - 1
   arr_Odd(n) = arr_even(n) + 1
  Next
'=============================

 For n = 2 To Sheets.Count
  Set find_rg = Sheets(n).Range("D:D").Find(My_St)
   If Not find_rg Is Nothing Then
      r = find_rg.Row
      Adr = find_rg.Address
      Set sh = Sheets(n)
  With Sheets("Home")
     
     .Cells(2, "F") = Sheets(n).Name & ":" & Adr
     .Cells(4, "C") = sh.Range(Adr)
     .Cells(6, "C") = sh.Range(Adr).Offset(, -1)
     .Cells(4, "K") = sh.Range(Adr).Offset(, -3)
     .Cells(6, "K") = sh.Range(Adr).Offset(, -2)
     '=====================================
    For k = LBound(arr_even) To UBound(arr_even)
      .Cells(14, col) = sh.Range(Adr).Offset(, arr_even(k))
       col = col + 1
       Next
       col = 2
     For k = LBound(arr_Odd) To UBound(arr_Odd)
      .Cells(15, col) = sh.Range(Adr).Offset(, arr_Odd(k))
       col = col + 1
       Next
     '=============================
     End With
      Exit For
     End If
    Next
    If r = 0 Then MsgBox "Not Found": Exit Sub
    Erase arr_even: Erase arr_Odd
End Sub

الملف مرفق

 

 

 

اFind_notes.xlsm

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

56 دقائق مضت, سليم حاصبيا said:

حرب هذا الكود للبحث فن الاسم

(يمكنك عمل مثله للبحث عن الرقم القومي)


Option Explicit
Sub find_St()
Dim My_St$: My_St = Sheets("Home").Cells(2, "J")
Dim sh As Worksheet
Dim r%, n%, SH_name$
Dim find_rg As Range
Dim Adr$, col%: col = 2
Dim k%
Dim arr_even(1 To 13)
Dim arr_Odd(1 To 12)
Range("My_range") = vbNullString
'==========================================

  arr_even(1) = 4: arr_even(2) = 6: arr_even(3) = 8: arr_even(4) = 10
  arr_even(5) = 12: arr_even(6) = 14: arr_even(7) = 18: arr_even(8) = 20
  arr_even(9) = 16: arr_even(10) = 22: arr_even(11) = 24: arr_even(12) = 26
  arr_even(13) = 28
  For n = 1 To UBound(arr_even) - 1
   arr_Odd(n) = arr_even(n) + 1
  Next
'=============================

 For n = 2 To Sheets.Count
  Set find_rg = Sheets(n).Range("D:D").Find(My_St)
   If Not find_rg Is Nothing Then
      r = find_rg.Row
      Adr = find_rg.Address
      Set sh = Sheets(n)
  With Sheets("Home")
     
     .Cells(2, "F") = Sheets(n).Name & ":" & Adr
     .Cells(4, "C") = sh.Range(Adr)
     .Cells(6, "C") = sh.Range(Adr).Offset(, -1)
     .Cells(4, "K") = sh.Range(Adr).Offset(, -3)
     .Cells(6, "K") = sh.Range(Adr).Offset(, -2)
     '=====================================
    For k = LBound(arr_even) To UBound(arr_even)
      .Cells(14, col) = sh.Range(Adr).Offset(, arr_even(k))
       col = col + 1
       Next
       col = 2
     For k = LBound(arr_Odd) To UBound(arr_Odd)
      .Cells(15, col) = sh.Range(Adr).Offset(, arr_Odd(k))
       col = col + 1
       Next
     '=============================
     End With
      Exit For
     End If
    Next
    If r = 0 Then MsgBox "Not Found": Exit Sub
    Erase arr_even: Erase arr_Odd
End Sub

الملف مرفق

 

 

 

اFind_notes.xlsm 885.67 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 0 downloads

الأستاذ الفاضل المحترم : سليم حاصبيا

تحية طيبة ... وبعد

أولا اتقدم لحضرتك والجميع بخالص الشكر والتقدير والعرفان على ما تقدموه .

ثانيًا : أعتذر عن الإطالة في طلبي ألا وهو أني كنت أقصد أن يتم البحث بأي من الثلاث أشياء الاسم - الأو الرقم القومي - أو رقم الجلوس . بمعني في حالة معرفة رقم الجلوس يتم البحث برقم الجلوس و في حالة معرفة الرقم القومي يتم البحث بالرقم القومي وفي حالة عدم معرفة كلاهما يتم البحث بالاسم وهذا يكون صعب الاعتماد عليه لاختلاف مدخلي البيانات فهناك من يكتب الاسم بهمزات وبدون همزات .

هذا ما كنت أتمناه من سيادتكم

وشكرا لحضراتكم جميعًا .

 

البحث بعدة معايير.xlsx

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

22 دقائق مضت, حاتم عيسى said:

الأستاذ الفاضل المحترم : سليم حاصبيا

تحية طيبة ... وبعد

أولا اتقدم لحضرتك والجميع بخالص الشكر والتقدير والعرفان على ما تقدموه .

ثانيًا : أعتذر عن الإطالة في طلبي ألا وهو أني كنت أقصد أن يتم البحث بأي من الثلاث أشياء الاسم - الأو الرقم القومي - أو رقم الجلوس . بمعني في حالة معرفة رقم الجلوس يتم البحث برقم الجلوس و في حالة معرفة الرقم القومي يتم البحث بالرقم القومي وفي حالة عدم معرفة كلاهما يتم البحث بالاسم وهذا يكون صعب الاعتماد عليه لاختلاف مدخلي البيانات فهناك من يكتب الاسم بهمزات وبدون همزات .

هذا ما كنت أتمناه من سيادتكم

وشكرا لحضراتكم جميعًا .

 

لا يمكن البحث برقم الجلوس لانه يتكرر في كل صفحة

مثلاً نبحث عن الرقم الجلوس 1650

اكسل يجد محمد في الشيت 2010

و يجد خليل في الشيت 2013

ويجد أحمد في الشيت 2015

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

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

6 دقائق مضت, سليم حاصبيا said:

لا يمكن البحث برقم الجلوس لانه يتكرر في كل صفحة

مثلاً نبحث عن الرقم القومي 1650

اكسل يجد محمد في الشيت 2010

و يجد خليل في الشيت 2013

ويجد أحمد في الشيت 2015

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

تم تعديل الملف حيث لا يتم تكرار رقم الجلوس . ومرفق نسخة منه ..... شكرا لحضرتك

اFind_notes.xlsm

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

الان يمكن العمل العمل بكل بساطة

Option Explicit

Sub find_Studant_Data()
On Error Resume Next
Dim My_St: My_St = Sheets("Home").Cells(2, "L")
Dim sh As Worksheet
Dim r%, n%, SH_name$
Dim find_rg As Range
Dim Adr$, col%: col = 2
Dim k%
Dim arr_Even(1 To 13)
Dim arr_Odd(1 To 12)
Range("My_range") = vbNullString
'==========================================

  arr_Even(1) = 6: arr_Even(2) = 8: arr_Even(3) = 10: arr_Even(4) = 12
  arr_Even(5) = 14: arr_Even(6) = 16: arr_Even(7) = 20: arr_Even(8) = 22
  arr_Even(9) = 18: arr_Even(10) = 24: arr_Even(11) = 26: arr_Even(12) = 28
  arr_Even(13) = 30
  For n = 1 To UBound(arr_Even) - 1
   arr_Odd(n) = arr_Even(n) + 1
  Next
'=============================

 For n = 2 To Sheets.Count
  Set find_rg = Sheets(n).Range("B:B").Find(My_St, Lookat:=xlWhole)
   If Not find_rg Is Nothing Then
      r = find_rg.Row
      Adr = find_rg.Address
      Set sh = Sheets(n)
  With Sheets("Home")
     
     .Cells(2, "F") = Sheets(n).Name & ":" & Adr
     .Cells(4, "C") = sh.Range(Adr).Offset(, 2)
     .Cells(6, "C") = sh.Range(Adr).Offset(, 1)
     .Cells(4, "K") = sh.Range(Adr).Offset(, -1)
     .Cells(6, "K") = sh.Range(Adr)
     .Cells(2, "J") = sh.Range(Adr).Offset(, -1)
     .Cells(2, "K") = sh.Range(Adr).Offset(, 2)
     '=====================================
    For k = LBound(arr_Even) To UBound(arr_Even)
      .Cells(14, col) = sh.Range(Adr).Offset(, arr_Even(k))
       col = col + 1
       Next
       col = 2
     For k = LBound(arr_Odd) To UBound(arr_Odd)
      .Cells(15, col) = sh.Range(Adr).Offset(, arr_Odd(k))
       col = col + 1
       Next
     '=============================
     End With
      Exit For
     End If
    Next
    If r = 0 Then MsgBox "Not Found" & Chr(10) & _
   "The Number: " & My_St & " Does't Exists", 64, "Salim Tell You"
    Erase arr_Even: Erase arr_Odd
End Sub

الملف مرفق

 

اFind_notes New_Edition.xlsm

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

الأستاذ الفاضل بارك الله في حضرتك كنت أتمنى أن يكون البحث عند إدخال أحد المتغيرات الثلاثة يتم البحث سواء الاسم الو الرقم القومي او رقم الجلوس أيهما يتم إدخاله يتم البحث . مع العلم بأنه لن يتم تكرار رقم الجلوس عند العمل على الشيت فتلك البيانات هي للتجربة فقط .
وشكرا لحضرتك .

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

24 دقائق مضت, حاتم عيسى said:

الأستاذ الفاضل بارك الله في حضرتك كنت أتمنى أن يكون البحث عند إدخال أحد المتغيرات الثلاثة يتم البحث سواء الاسم الو الرقم القومي او رقم الجلوس أيهما يتم إدخاله يتم البحث . مع العلم بأنه لن يتم تكرار رقم الجلوس عند العمل على الشيت فتلك البيانات هي للتجربة فقط .
وشكرا لحضرتك .

في أول كود تمت عملية البحث باستخدام الاسم

يمكنك ادراج زر مخصص لهذا الكود

بقي الرقم القومي تفعله مشابهاً للماكرو  عملية البحث باستخدام الاسم

مع ادراج المصفوفات Arr_ODD  &  ARR-Even بما يتناسب مع وضع العامود الذي نبحث فيه

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

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

1 دقيقه مضت, سليم حاصبيا said:

في أول كود تمت عملية البحث باستخدام الاسم

يمكنك ادراج زر مخصص لهذا الكود

بقي الرقم القومي تفعله مشابهاً للماكرو  عملية البحث باستخدام الاسم

مع ادراج المصفوفات Arr_ODD  &  ARR-Even بما يتناسب مع وضع العامود الذي نبحث فيه

ممكن أطمع في كرم أخلاق حضرتك في تنفيذ المثال كما أخبرت حضرتك في المشاركة السابقة بتنفيذ الأزرار وربطها .

بارك الله في حضرتك

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

20 دقائق مضت, حاتم عيسى said:

ممكن أطمع في كرم أخلاق حضرتك في تنفيذ المثال كما أخبرت حضرتك في المشاركة السابقة بتنفيذ الأزرار وربطها .

بارك الله في حضرتك

شاهد هذا الفيديو التعليمي بهذا الشأن

https://www.youtube.com/watch?v=eLWRqGGdGEQ

 

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

ممكن من فضل حضرتك وكرمك ( شرح الكود المستخدم للبحث بالاسم ) وشرح متغيراته حتى أستطيع التعديل عليه حتي يصبح للبحث عن الرقم القومي .

إن أمكن الشرح بالعربي

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

الأستاذ الفاضل المحترم " سليم حاصبيا

تحية طيبة من عند الله

جزاكم الله كل الخير على ما قدمتموه وما تقدموه لنا من معلومات قيمة ومفيدة .

تم بفضل الله ثم بفضل حضراتكم تنفيذ ما هو مطلوب علي الملف السابق .

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

المطلوب : تحديد صفحات معينة يتم البحث فيها دون غيرها حيث أنني سوف أدرج صفحات جديدة في نفس الملف ولكن للعمل عليها للمرحلة الإعدادية .... كذلك في حالة إضافة أي صفحات لا يبحث إلا في النطاق المحدد للبحث فقط .

مرفق الملف المطلوب التعديل عليه .

وجزاكم الله خيرا .

 

اFind_notes - 2.xlsm

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

الخلايا المدمجة عدو الاكواد الأول ///لا يمكن ان تنسخ رقم  (الرقم القومي مثلا أو الاسم) من خلية عادية الى مجموعة حلايا مدمجة بدون مشاكل)///

لذلك كي أستطيع المساعدة عليك انشاء ملف جديد (مختصر بالبيانات  قدر الامكان)

مثلاً 4 صفحات(A,B,C,D) في كل منها 10 صفوف  لا أكثر بدون خلايا مدمجة و بدون زوزقة ألوان تبهر النظر)

تستطيع تنسيق الخلايا وتلوينها كما تريد بعد التأكد من عمل الأكواد

فعندما تعمل على ملف صغير تستطيع ان ترى ما يفعله الكود و بعدها تعمم الكود على الملفات الكبيرة

لا أعرف لماذا استعمال (الخلايا المدمجة) طالما يستطيع المستخدم اختيار عرض العامو د و ارتفاع الصف حسب حاجته

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

3 ساعات مضت, سليم حاصبيا said:

الخلايا المدمجة عدو الاكواد الأول ///لا يمكن ان تنسخ رقم  (الرقم القومي مثلا أو الاسم) من خلية عادية الى مجموعة حلايا مدمجة بدون مشاكل)///

لذلك كي أستطيع المساعدة عليك انشاء ملف جديد (مختصر بالبيانات  قدر الامكان)

مثلاً 4 صفحات(A,B,C,D) في كل منها 10 صفوف  لا أكثر بدون خلايا مدمجة و بدون زوزقة ألوان تبهر النظر)

تستطيع تنسيق الخلايا وتلوينها كما تريد بعد التأكد من عمل الأكواد

فعندما تعمل على ملف صغير تستطيع ان ترى ما يفعله الكود و بعدها تعمم الكود على الملفات الكبيرة

لا أعرف لماذا استعمال (الخلايا المدمجة) طالما يستطيع المستخدم اختيار عرض العامو د و ارتفاع الصف حسب حاجته

أعتذر شديد الاعتذار وبالغ الأسف لحضرتك وإرهاق حضرتك ..

إلى حضرتك الملف كما طلبت ولسيادتكم جزيل الشكر والتقدير .

ودائما نتعلم من معاليكم

اFind_notes - 2 - Copy.xlsm

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

في الملف المرفق منك يا استاذ حاتم بعض الاخطاء (يجب تصحيحها كي يعمل الكود بكفاءة)

1- الرقم القومي في البداية موجود وفي العامود الاول ورقم الجلوس في الثاني

  اما في الشيتات بعد  2Home تنعكس الاية (تم تصحيح الامر بالنسبة لهذه النقطة)

2 _اختلاف في محتوبات الاعمدة بين الصفحات قبل 2Home وبعدها (مثال اللغة العربية  في  Column H  ثم في Column G)

     في الملف المرفق مني تم حذف 2Home والاستعانة بورقة Fasel (فارغة)    تفصل بين الاعدادي والابتدائي والتي يأخذها الاكسل كمرجع لبداية          البحث) (تم ادراج عاموين فارغين قبل اللغة العربية في الاعداديات ليصبح كل شيء في موقعه الصحيح)

كيفية العمل بالكود

1- الصفحة Fasel يمكن اخفاؤها لانها فقط فاصل بين المرحلتين(اختيارياُ)

4- المرحلة الابتدائية يبدأ لبحث من الصفحة 2 حتى ما قبل الصفحة Fasel

5- المرحلة الاعدادية يبدأ البحث من الصفحة ما بعد Fasel الى نهاية عدد الصفحات

6 - تختار ابتدائي او اعدادي من القائمة المنسدلة في الخلية P2 صفحة Home ثم تكتب الرقم القومي وتضغط الزر

الآن لوّن و زخرف كما تشاء 

الكود

Option Explicit

Sub find_Studant_Data()

Dim sh_ind%
sh_ind = Sheets("fasel").Index
Dim start_page%, end_page%
On Error Resume Next
Dim My_St: My_St = Sheets("Home").Cells(2, "L")
Dim sh As Worksheet
Dim r%, n%, SH_name$
Dim find_rg As Range
Dim Adr$, col%: col = 2
Dim k%
Dim arr_Even(1 To 13)
Dim arr_Odd(1 To 12)
Range("My_range") = vbNullString
'==========================================

  arr_Even(1) = 6: arr_Even(2) = 8: arr_Even(3) = 10: arr_Even(4) = 12
  arr_Even(5) = 14: arr_Even(6) = 16: arr_Even(7) = 20: arr_Even(8) = 22
  arr_Even(9) = 18: arr_Even(10) = 24: arr_Even(11) = 26: arr_Even(12) = 28
  arr_Even(13) = 30
  For n = 1 To UBound(arr_Even) - 1
   arr_Odd(n) = arr_Even(n) + 1
  Next
'=============================
  Select Case Sheets("Home").Cells(2, "P")
   Case "الابتدائى": start_page = 2: end_page = sh_ind - 1
   Case Else: start_page = sh_ind + 1: end_page = Sheets.Count
   End Select
 For n = start_page To end_page
  Set find_rg = Sheets(n).Range("B:B").Find(My_St, Lookat:=xlWhole)
   If Not find_rg Is Nothing Then
      r = find_rg.Row
      Adr = find_rg.Address
      Set sh = Sheets(n)
  With Sheets("Home")
     
     .Cells(2, "F") = Sheets(n).Name & ":" & Adr 'KK
     .Cells(4, "B") = sh.Range(Adr).Offset(, 2) 'ok
     .Cells(4, "K") = sh.Range(Adr).Offset(, -1) 'ok
     .Cells(5, "B") = sh.Range(Adr).Offset(, 1) 'ok
     .Cells(5, "K") = sh.Range(Adr)
   
     .Cells(3, "A") = Sheets(n).Cells(1, "G") & " " & .Cells(6, "c")
     '=====================================
    For k = LBound(arr_Even) To UBound(arr_Even)
      .Cells(12, col) = sh.Range(Adr).Offset(, arr_Even(k))
       col = col + 1
       Next
       col = 2
     For k = LBound(arr_Odd) To UBound(arr_Odd)
      .Cells(13, col) = sh.Range(Adr).Offset(, arr_Odd(k))
       col = col + 1
       Next
     '=============================
     End With
      Exit For
     End If
    Next
    If r = 0 Then MsgBox "Not Found" & Chr(10) & _
   "The Number: " & My_St & " Does't Exists", 64, "Salim Tell You"
    Erase arr_Even: Erase arr_Odd
End Sub

الملف

 

 

Super_notes.xlsm

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

شكرا لحضرتك أستاذ : سليم المحترم .

وجزاك الله كل الخير وجعل جميع أعمالك في موازيين حسناتك .

وبارك الله في حضرتك وزادك من فضله وعلمه .

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

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