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

بحث بالصف


إذهب إلى أفضل إجابة Solved by سليم حاصبيا,

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

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

بحث بالصف.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

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

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

  

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

تم التعديل

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

  • 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