مدموج :تسريع الكود

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

Application.EnableEvents = False

Application.ScreenUpdating = False

Application.Calculation = xlManual



Application.EnableEvents = True

Application.ScreenUpdating = True

Application.Calculation = xlAutomatic

Private Sub TextBox1_Change()

WSLR = WS.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 = WS.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) = WS.Cells(RO2, 5 - K).Value

         Next

            Set f_RG = WS.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 TextBox1_Change()

WSLR = WS.Cells(Rows.Count, 1).End(xlUp).Row

K = 0

On Error Resume Next

    With Me.ListBox1

        .Clear

        .ColumnCount = 4

        For Each C In WS.Range("B2:B" & WSLR)

            If TextBox1.Value <> "" Then

                If C Like "*" & TextBox1.Value & "*" Then

                    .AddItem

                    .List(K, 0) = WS.Cells(C.Row, 5).Value

                    .List(K, 1) = WS.Cells(C.Row, 4).Value

                    .List(K, 2) = WS.Cells(C.Row, 3).Value

                    .List(K, 3) = WS.Cells(C.Row, 2).Value

                    .List(K, 4) = C.Row

                    K = K + 1

                End If

            End If

        Next C

    End With

End Sub