excel vba通过行更快
下面的代码工作100％。 它扫描列B中的匹配项，并在find匹配项时复制并重命名一组单元格。 然而， For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1其中step -1将扫描行从纸张的底部开始排列直到find匹配。 如果步骤设置为“ End.(xlUp)而不是-1 ，则会更容易。 End.(xlUp)会大量减less运行时间，因此search每一行都是过度的。 是这样的可能吗？
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
我不知道这是否会有所帮助，但是我已经有了很大的性能提升，将所需的整个范围循环到一个variables数组中，然后遍历数组。 如果我需要循环大数据集，这个方法已经很好的了。
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
希望这可以帮助。
看看从底层做一个.find。
从范围的底部开始，在vba内执行查找
这将消除从最后一行到您想要查找的值的第一次出现的for循环的需要。