用户表单执行时间过长

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

您不需要 select 每个单元格都可以设置它的值。您可以通过引用单元格对象本身来简单地做到这一点。使用 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)

仔细检查我的数学 - 我刚刚添加和减去您的偏移量以生成此示例代码。

Answer 2

将数据放入数组并循环遍历它应该快得多 - 像这样（我想我的列是正确的）：

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

用户表单执行时间过长

User form is taking to long to execute

excel

vba

textbox

userform