vbaのステップを高速に実行する

Question

以下のコードは100％動作します。列Bの一致をスキャンし、一致が見つかった場合にセルのグループをコピーして名前を変更します。ただし、行はFor lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1 です。step -1は、シートの一番下から行が1行ずつスキャンされ、一致するものが見つかるまで続きます。ステップが-1の代わりにEnd.(xlUp)に設定されていれば、はるかに簡単です。すべての行を検索することは、データの設定方法が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

ボトムアップから.findを実行します。

場所を特定したい値の最初の出現に最後の行からのループのために行う必要がなくなります Perform a FIND, within vba, from the bottom of a range up

。

Answer 2

これが役立つかどうかはわかりませんが、バリアント配列にループして配列をループするのに必要な範囲全体を引き上げると、パフォーマンスが大幅に向上しました。大規模なデータセットをループする必要がある場合、この方法はうまくいきました。

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 

これが役に立ちます。