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

حاتم عيسى · مارس 18, 2019

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

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

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

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

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

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

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

**سليم حاصبيا** · مارس 19, 2019

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

**سليم حاصبيا** · مارس 19, 2019

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

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

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

حاتم عيسى · مارس 19, 2019

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

تم تعديل مارس 19, 2019 بواسطه حاتم عيسى

**سليم حاصبيا** · مارس 19, 2019

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

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

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

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

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

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

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

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

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

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

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

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

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

حاتم عيسى · مارس 19, 2019

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

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

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

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

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

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

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

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

اFind_notes.xlsm

**سليم حاصبيا** · مارس 19, 2019

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

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

**Ali Mohamed Ali** · مارس 19, 2019

أحسنت أستاذ سليم عمل ممتاز بارك الله فيك

حاتم عيسى · مارس 19, 2019

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

**سليم حاصبيا** · مارس 19, 2019

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

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

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

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

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

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

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

حاتم عيسى · مارس 19, 2019

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

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

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

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

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

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

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

**سليم حاصبيا** · مارس 19, 2019

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

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

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

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

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

حاتم عيسى · مارس 19, 2019

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

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

تم تعديل مارس 19, 2019 بواسطه حاتم عيسى

حاتم عيسى · مارس 19, 2019

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

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

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

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

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

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

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

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

اFind_notes - 2.xlsm

**سليم حاصبيا** · مارس 20, 2019

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

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

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

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

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

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

حاتم عيسى · مارس 20, 2019

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

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

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

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

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

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

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

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

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

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

اFind_notes - 2 - Copy.xlsm

**سليم حاصبيا** · مارس 20, 2019

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

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

**Ali Mohamed Ali** · مارس 20, 2019

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

حاتم عيسى · مارس 20, 2019

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

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

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

تسجيل الدخول

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

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

حاتم عيسى

سليم حاصبيا

سليم حاصبيا

حاتم عيسى

سليم حاصبيا

حاتم عيسى

سليم حاصبيا

Ali Mohamed Ali

حاتم عيسى

سليم حاصبيا

حاتم عيسى

سليم حاصبيا

حاتم عيسى

حاتم عيسى

سليم حاصبيا

حاتم عيسى

سليم حاصبيا

Ali Mohamed Ali

حاتم عيسى

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information