
جرب هذا الملف الذي لا يعتمد على الحلقات التكرارية من 1 الى 10000
بل يستعمل الدالة الرائعة FIND التي تضع يدها مباشرة على الخلية المطلوبة لمعرفة رقم الصف لهذه الخلية
الملف مرفق
بل يستعمل الدالة الرائعة FIND التي تضع يدها مباشرة على الخلية المطلوبة لمعرفة رقم الصف لهذه الخلية
Option Explicit
Dim SH2 As Worksheet, SH1 As Worksheet
Dim I As Long, RO As Long, WSLR As Long
Dim SHLR As Long, res As Long, SS As Long
Dim C As Range, K As Integer, MOT
Dim f_RG As Range, RO1%, RO2%
Private Sub UserForm_Initialize()
Set SH1 = ThisWorkbook.Worksheets("ورقة1")
Set SH2 = ThisWorkbook.Worksheets("ورقة2")
WSLR = SH1.Cells(Rows.Count, 1).End(xlUp).Row
End Sub
'++++++++++++++++++++++++++++++++++++++++++
Private Sub TextBox1_Change()
WSLR = SH2.Cells(Rows.Count, 1).End(xlUp).Row
MOT = "*" & TextBox1.Value & "*"
If Len(MOT) <= 2 Then Exit Sub
If Me.ListBox1.ListIndex >= 0 Then Exit Sub
With Me.ListBox1
.Clear
.ColumnCount = 4
Set f_RG = SH2.Range("B1:B" & WSLR).Find(MOT, LOOKAT:=1)
If Not f_RG Is Nothing Then
RO1 = f_RG.Row: RO2 = RO1
Do
.AddItem
For K = 0 To .ColumnCount - 1
.List(.ListCount - 1, K) = SH2.Cells(RO2, 5 - K).Value
Next
Set f_RG = SH2.Range("B1:B" & WSLR).FindNext(f_RG)
RO2 = f_RG.Row
If RO2 = RO1 Then Exit Do
Loop
End If
End With
End Sub
'++++++++++++++++++++++++++++++++++++++++++
Private Sub CommandButton1_Click()
SHLR = SH1.Cells(Rows.Count, 2).End(xlUp).Row + 1
With SH1.Range("B" & SHLR)
.Value = TextBox1.Value: TextBox1 = ""
.Offset(0, 1) = TextBox2.Value: TextBox2 = ""
.Offset(0, 2) = _
IIf(OptionButton1 = True, OptionButton1.Caption, OptionButton2.Caption)
.Offset(0, 3) = TextBox4.Value
TextBox4 = ""
End With
ListBox1.Clear
End Sub
'++++++++++++++++++++++++++++++++++++++++++
Private Sub ListBox1_Click()
Dim X
X = Me.ListBox1.ListIndex
If X < 0 Then Exit Sub
TextBox2.Text = Me.ListBox1.List(X, 2)
Select Case True
Case Me.ListBox1.List(X, 1) = "ابتدائي"
OptionButton2 = True: OptionButton1 = False
Case Else
OptionButton2 = False: OptionButton1 = True
End Select
TextBox4.Text = Me.ListBox1.List(X, 0)
TextBox1.Value = Me.ListBox1.List(X, 3)
Me.ListBox1.ListIndex = -1
End Sub
الملف مرفق