excel vba daha hızlı satırlar arası

Question

aşağıdaki kod% 100 çalışır. B sütununda bir eşleşme için tarama yapar ve bir eşleşme bulunduğunda bir grup hücreyi kopyalar ve yeniden adlandırır. Ancak, For lRow = Sheets("HR-Calc").Cells(Cells.Rows.count, "b").End(xlUp).Row To 7 Step -1 numaralı bir satırdır. step -1, bir eşleşme bulunana kadar sayfanın altından satır sıraya göre tarama yapar. Adım -1 yerine End.(xlUp) olarak ayarlanmışsa çok daha kolay olurdu. Her satırın aranması, verilerin nasıl ayarlandığından dolayı overkill'tir. End.(xlUp), çalışma süresini büyük ölçüde azaltır. Böyle bir şey mümkün mü?

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

Aşağıdan yukarıya doğru bir göz atın.

bulmak istediğiniz değerin ilk geçtiği son satırdan döngü için yapmak ihtiyacını ortadan kaldırır Perform a FIND, within vba, from the bottom of a range up

.

Answer 2

Bunun işe yarayıp yaramayacağından emin değilim, ancak değişken bir dizi içinde döngülendirmeniz gereken tüm aralığı çekerek ve ardından dizi boyunca döngü yaparak mükemmel bir performans artışı yaşadım. Büyük veri kümeleri arasında geçiş yapmam gerekirse, bu yöntem iyi sonuç verdi.

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 

Ayrıca, döngüyü yürütmeden önce sütun dizinlerini de tanımlayabilirsiniz. O zaman sadece bunları doğrudan döngü içinde çekmeniz için gerekenleri yapmanız gerekir.

'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 

Bu yardımcı olur umarım.