Форма пользователя занимает много времени, чтобы выполнить

Question

У меня есть эта пользовательская форма, и поиск занимает много времени. Можно ли как-нибудь сократить это время?

Вот код текстового поля пользовательской формы, куда я помещаю то, что ищу:

Private Sub TXTBUSCAART_Change()
     Application.ScreenUpdating = False

     Sheets("CONCAT").Select
     Range("A2").Select
     LSTART.Clear

     While ActiveCell.Value <> ""
         M = InStr(1, ActiveCell.Value, UCase(TXTBUSCAART.Text))

         If M > 0 Then
             LSTART.ColumnCount = 9
             LSTART.AddItem         

             LSTART.List(LSTART.ListCount - 1, 0) = ActiveCell.Value
             ActiveCell.Offset(0, 2).Select
             LSTART.List(LSTART.ListCount - 1, 1) = ActiveCell.Value
             ActiveCell.Offset(0, -1).Select
             LSTART.List(LSTART.ListCount - 1, 2) = ActiveCell.Value
             ActiveCell.Offset(0, 2).Select
             LSTART.List(LSTART.ListCount - 1, 3) = ActiveCell.Value
             ActiveCell.Offset(0, 2).Select
             LSTART.List(LSTART.ListCount - 1, 4) = ActiveCell.Value
             ActiveCell.Offset(0, -1).Select
             LSTART.List(LSTART.ListCount - 1, 5) = ActiveCell.Value
             ActiveCell.Offset(0, 3).Select
             LSTART.List(LSTART.ListCount - 1, 6) = ActiveCell.Value
             ActiveCell.Offset(0, 1).Select
             LSTART.List(LSTART.ListCount - 1, 7) = ActiveCell.Value
             ActiveCell.Offset(0, -2).Select
             LSTART.List(LSTART.ListCount - 1, 8) = ActiveCell.Value
             ActiveCell.Offset(0, -6).Select
         End If

         ActiveCell.Offset(1, 0).Select
     Wend

     Sheets("REMITO").Select
     Range("A1").Select

     Application.ScreenUpdating = False
 End Sub

Answer 1

Должно быть намного быстрее помещать данные в массив и проходить через них - что-то вроде этого (думаю, я правильно понял столбцы):

Private Sub TXTBUSCAART_Change()
    Dim rowCount As Long, itemCount As Long, counter As Long, n As Long
    Dim dataSheet As Worksheet
    Dim dataIn, dataOut()

    LSTART.Clear
    LSTART.ColumnCount = 9

    Set dataSheet = Sheets("CONCAT")
    With dataSheet

        rowCount = .Cells(.Rows.Count, "A").End(xlUp).Row
        itemCount = Application.WorksheetFunction.CountIf(.Range("A2:A" & rowCount), "*" & TXTBUSCAART.Text & "*")

        If itemCount > 0 Then
            ReDim dataOut(1 To itemCount, 1 To 9)
            dataIn = .Range("A2:I" & rowCount).Value
            counter = 1

            For n = 1 To UBound(dataIn)
                M = InStr(1, dataIn(1, 1), UCase(TXTBUSCAART.Text))
                If M > 0 Then
                    dataOut(counter, 1) = dataIn(n, 1)
                    dataOut(counter, 2) = dataIn(n, 3)
                    dataOut(counter, 3) = dataIn(n, 2)
                    dataOut(counter, 4) = dataIn(n, 4)
                    dataOut(counter, 5) = dataIn(n, 6)
                    dataOut(counter, 6) = dataIn(n, 5)
                    dataOut(counter, 7) = dataIn(n, 8)
                    dataOut(counter, 8) = dataIn(n, 9)
                    dataOut(counter, 9) = dataIn(n, 7)
                    counter = counter + 1
                End If
            Next

        LSTART.List = dataOut

        End If
    End With

End Sub

Answer 2

Вам не нужно выбирать каждую ячейку перед установкой ее значения. Вы можете сделать это, просто ссылаясь на сам объект ячейки. Используя функцию ярлыка Cells, если вы не запрашиваете определенное свойство, по умолчанию возвращается значение ячейки.

Таким образом, для части цикла вы можете добиться некоторой скорости, делая это (особенно если этот цикл when многократно повторяется):

 LSTART.List(LSTART.ListCount - 1, 0) = Cells(1, 2)
 LSTART.List(LSTART.ListCount - 1, 1) = Cells(1, 4)
 LSTART.List(LSTART.ListCount - 1, 2) = Cells(1, 3)
 LSTART.List(LSTART.ListCount - 1, 3) = Cells(1, 5)
 LSTART.List(LSTART.ListCount - 1, 4) = Cells(1, 7)
 LSTART.List(LSTART.ListCount - 1, 5) = Cells(1, 6)
 LSTART.List(LSTART.ListCount - 1, 6) = Cells(1, 9)
 LSTART.List(LSTART.ListCount - 1, 7) = Cells(1, 10)
 LSTART.List(LSTART.ListCount - 1, 8) = Cells(1, 8)

Дважды проверьте мою математику - я просто добавил и вычел ваши смещения, чтобы сгенерировать этот пример кода.