بحث بالصف

[فوزى فوزى]

كيف لى جلب بيانات المدرس اعتمادا على الصف مع العلم ان المدرس له صفوف مشتركة  2 تنسيق شرطي للفصل عند اختيار الفصل من القائمة المنسدلة من الخلية g3 يتم تلوين كلمة الصف الأول افتراضا مثل ما يوجد في الشيت وان كان الحل بالمعادلات يكون افضل

بحث بالصف.xlsx

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

جرب هذا الشيء

Fuzi_class.xlsx

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

تم معالجة الأمر

1- لبس المرة الأولى التي أقول فيها:
   تسمية الشيتات باللغة الأجنبية  و  فصل الجدول عن باقي الخلايا بصفوف فارغة
   و عدم ادراج خلايا مدمجة داخل الجدول   /  ولا حياة لمن تنادي   /
    (تم اضافة صفوف فارغة لهذا الأمر لآخر مرّة لن امد يد المساعدة بعد الآن بدون هذه الأشياء)

2- اذا كات الخلية B2  فارغة تحصل على كل البيانات

Option Explicit
Sub FInd_Please()
Dim S As Worksheet, T As Worksheet
Dim LR As Long, Nam As String
Dim F_rg As Range, d%
Dim Find_wath
Dim Search_rg As Range
Dim x%, y%, n%
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set S = Sheets("Source")
Set T = Sheets("Target")
 T.Range("C8").CurrentRegion.ClearContents
 x = S.Range("A8").CurrentRegion.Rows.Count
 y = S.Range("A8").CurrentRegion.Columns.Count
If T.Range("c2") = vbNullString Then GoTo Exit_Sub
 Select Case T.Range("C2")
    Case "مسلسل": n = 1
    Case "اسم التلميذ": n = 2
    Case "الرقم القومي": n = 3
    Case "المحافظة": n = 4
    Case "تاريخ الميلاد": n = 5
    Case Else: GoTo Exit_Sub
 End Select
 
 Select Case T.Range("B2")
  Case Is <> ""
  Find_wath = T.Range("B2")
  Case Else
  Find_wath = "*"
 End Select

If Find_wath = "*" Then
    T.Range("A9").Resize(x, y).Value = _
    S.Range("A8").Resize(x, y).Value
Else
    Set F_rg = S.Range("A7").CurrentRegion.Columns(n)
    Set Search_rg = F_rg.Find(Find_wath, lookat:=1)
    If Search_rg Is Nothing Then
        MsgBox "Check Up the Cell B2"
        GoTo Exit_Sub
    End If
T.Range("A9").Resize(, y).Value = _
S.Range("A" & Search_rg.Row).Resize(, y).Value
End If
Exit_Sub:

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

End Sub

 

 

fuzy_data.xlsm

[فوزى فوزى]

الف شكر استاذ سليم وجزاكم الله بالاحسان احسانا استاذ سليم عند الاختيار من القائمة المنسدلة والبحث بالمحافظة ياتى لى باول قيمة ويتجاهل الفيم الاخرى المقروض ياتى لى بكل القبم التى تشمل اسم المحافظة وتاريخ الميلاد كذلك عند الاختيار البحث بتاريخ الميلاد المفروض ياتى لى بكل القيم التى تحمل نفس تاريخ الميلاد

  

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

تم التعديل

Option Explicit
Sub FInd_Please()
Dim S As Worksheet, T As Worksheet
Dim LR%, x%, y%, n%, m%
Dim F_rg As Range, Search_rg As Range
Dim Find_wath
Dim Ad1$, Ad2$

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set S = Sheets("Source")
Set T = Sheets("Target")
 With T.Range("C8").CurrentRegion
 .ClearContents
 .Interior.ColorIndex = xlNone
 End With
 x = S.Range("A8").CurrentRegion.Rows.Count
 y = S.Range("A8").CurrentRegion.Columns.Count
If T.Range("c2") = vbNullString Then GoTo Exit_Sub
 Select Case T.Range("C2")
    Case "مسلسل": n = 1
    Case "اسم التلميذ": n = 2
    Case "الرقم القومي": n = 3
    Case "المحافظة": n = 4
    Case "تاريخ الميلاد": n = 5
    Case Else: GoTo Exit_Sub
 End Select
 
 Select Case T.Range("B2")
  Case Is <> ""
  Find_wath = T.Range("B2")
  Case Else
  Find_wath = "*"
 End Select

If Find_wath = "*" Then
    T.Range("A9").Resize(x, y).Value = _
    S.Range("A8").Resize(x, y).Value
Else
    Set F_rg = S.Range("A7").CurrentRegion.Columns(n)
    Set Search_rg = F_rg.Find(Find_wath, LookIn:=xlValues, lookat:=1)
      If Search_rg Is Nothing Then
          MsgBox "Check Up the Cell B2"
          GoTo Exit_Sub
      End If
  Ad1 = Search_rg.Address: Ad2 = Ad1
  m = 9
      Do
         T.Range("A" & m).Resize(, y).Value = _
         S.Range("A" & Search_rg.Row).Resize(, y).Value
         m = m + 1
         Set Search_rg = F_rg.FindNext(Search_rg)
         Ad2 = Search_rg.Address
        If Ad1 = Ad2 Then Exit Do
      Loop
     T.Range("A9").Resize(m - 9, 12) _
     .Interior.ColorIndex = 19
End If


Exit_Sub:

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

End Sub

 

fuzy_data_new.xlsm

[فوزى فوزى]

ما اروعك استاذ سليم كود يفى بالموضوع تمام 

سلمت يمينك وبارك الله فيك حفظك الله

اشكرك سيدى الاستاذ سليم