Question

以下代码可以100％运行。它会扫描B列中的匹配项，并在找到匹配项时复制并重命名一组单元格。然而，这是一行For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1 step -1将从工作表底部逐行扫描，直到找到匹配为止。如果将步骤设置为End.(xlUp)而不是-1，则会容易得多。搜索每一行都是过度的，因为数据的设置方式End.(xlUp)会大大缩短运行时间。这样的事情可能吗？

Sub Fill_CB_Calc()

M_Start:

Application.ScreenUpdating = True

Sheets("summary").Activate
d_input = Application.InputBox("select first cell in data column", "Column Data Check", Default:="", Type:=8).Address(ReferenceStyle:=xlA1, RowAbsolute:=True, ColumnAbsolute:=False)

data_col = Left(d_input, InStr(2, d_input, "$") - 1)
data_row = Right(d_input, Len(d_input) - InStr(2, d_input, "$"))

Application.ScreenUpdating = False

Sheets("summary").Activate
Range(d_input).End(xlDown).Select

data_last = ActiveCell.Row

If IsEmpty(Range(data_col & data_row + 1)) = True Then
    data_last = data_row

Else
End If

    For j = data_row To data_last

CBtype = Sheets("summary").Range(data_col & j)

    Sheets("HR-Calc").Activate
    For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1

    If Sheets("HR-Calc").Cells(lRow, "b") = CBtype Then

            CBend = Sheets("HR-Calc").Range("C" & lRow).End(xlDown).Row + 1
            Sheets("HR-Calc").Rows(lRow & ":" & CBend).Copy

            CBstart = Sheets("HR-Calc").Range("c50000").End(xlUp).Row + 2

            ActiveWindow.ScrollRow = CBstart - 8

            Sheets("HR-Calc").Range("A" & CBstart).Insert Shift:=xlDown

            CBold = Right(Range("c" & CBstart), Len(Range("C" & CBstart)) - 2)

                box_name = Sheets("summary").Range(data_col & j).Offset(0, -10)

                CBnew = Right(box_name, Len(box_name) - 2) & "-"  ' <--this is custom and can be changed based on CB naming structure
                If CBnew = "" Or vbCancel Then
                End If
            CBend2 = Range("c50000").End(xlUp).Row - 2

            Range("C" & CBstart + 1 & ":" & "C" & CBend2).Select
                Selection.Replace What:=CBold & "-", Replacement:=CBnew, LookAt:=xlPart, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False

            Range("C" & CBstart).FormulaR1C1 = "CB" & Left(CBnew, Len(CBnew) - 1)

            GoTo M_Start2
    Else

    End If

Next lRow
M_Start2:
            Next j

YN_result = MsgBox("Fill info for another block/inverter?", vbYesNo + vbExclamation)
If YN_result = vbYes Then GoTo M_Start
If YN_result = vbNo Then GoTo jumpout

jumpout:
'    Sheets("summary").Range(d_input).Select
    Application.ScreenUpdating = True
End Sub

Answer 1

我不确定这是否会有所帮助，但我已经将整个范围提升到一个变量数组然后循环遍历数组，从而获得了极大的性能提升。如果我需要遍历大型数据集，这种方法已经很好地完成了。

Dim varArray as Variant
varArray = Range(....) 'set varArray to the range you're looping through
For y = 1 to uBound(varArray,1)  'loops through rows of the array
    'code for each row here
    'to loop through individual columns in that row, throw in another loop
    For x = 1 to uBound(varArray, 2) 'loop through columns of array
       'code here
    Next x
Next y

您还可以在执行循环之前定义列索引。然后你只需执行你需要直接在循环中拉出它们。

'prior to executing the loop, define the column index of what you need to look at
Dim colRevenue as Integer
colRevenue = 5 'or a find function that searches for a header named "Revenue"

Dim varArray as Variant
    varArray = Range(....) 'set varArray to the range you're looping through
For y = 1 to uBound(varArray,1)  'loops through rows of the array
    tmpRevenue = CDbl(varArray(y, colRevenue))
Next y

希望这有帮助。

Answer 2

从下往上看.find。

Perform a FIND, within vba, from the bottom of a range up

这将消除从最后一行到您想要定位的值的第一次出现的for循环的需要。

excel vba step thru rows更快

2 个答案: