有了VBA,有没有一种更有效的方法来循环遍历Excel中的行,然后从循环内循环多次循环两次?

我的电子表格有几千行。 其中一些行需要在它们之间整合一些数据。 我可以通过缺less特定列中的值来识别这些行。 一旦find该行,我需要search两个OTHER行,然后将两个值相加在一起。 结果然后被应用到我的原始行中的单元格。

这是我的电子表格的一个例子。

| Subject | Title | Total Clicks | |-----------|-------------------|--------------| | | title 1 | 0 | // Needs to be 230 | Subject 1 | title 1 | Combo 1 | 110 | | Subject 1 | title 1 | Combo 2 | 120 | | Subject 2 | title 2 | 123 | | | title 3 | 0 | // Needs to be 66 | Subject 3 | title 3 | Combo 1 | 21 | | Subject 3 | title 3 | Combo 2 | 45 | 

标题列中以“标题1”开头的行是匹配的行。 我需要从“总点击数”列中获取点击数,将它们加在一起,并将其添加到没有主题值的行的匹配单元格中。 因此,例如,“标题1”的行目前总共有0个点击。 macros运行后,会说230,因为我会加110到120。

匹配的行不总是以相同的顺序,它们可以在任何地方。

我目前正在testing这个代码的范围,总共有37列和3624总行。 完成所需的时间有点疯狂。 有什么我可以做的,以加快这个过程? 我的代码如下。

 Public Sub loopThroughRows() Dim rng As Range, rw As Range, rwA As Range, rwB As Range Set rng = Selection subjectCol = 2 'Our first loop will look for this cell and do something if it's empty titleCol = 1 'If the cell above is empty, our second and third loops will look at this cell totalClicksCol = 18 'Loop through all rows that are selected For Each rw In rng.Rows 'If cell in column 2 in the current row is blank, continue. Otherwise skip to the next row If rng.Cells(rw.Row, subjectCol).Value = "" Then 'Set two variables based on the value found in column 1. There will be two more rows in our loop that are identical in value + an extra string. titleValue1 = rng.Cells(rw.Row, titleCol).Value & " | Combo 1" titleValue2 = rng.Cells(rw.Row, titleCol).Value & " | Combo 2" 'Loop through all rows again, looking for the first value in column 1 that matches the variable titleValue1 For Each rwA In rng.Rows If rng.Cells(rwA.Row, titleCol).Value = titleValue1 Then 'Set the value found in Column C of this matching row to a new variable totalClicks1 = rng.Cells(rwA.Row, totalClicksCol).Value Exit For End If Next 'Loop through all rows again, looking for the first value in column 1 that matches the variable titleValue2 For Each rwB In rng.Rows If rng.Cells(rwB.Row, titleCol).Value = titleValue2 Then 'Set the value found in Column C of this matching row to a new variable totalClicks2 = rng.Cells(rwB.Row, totalClicksCol).Value Exit For End If Next 'Add together the two values we found from the two above loops and set it as the value of column 18 in the row of our original loop rng.Cells(rw.Row, totalClicksCol).Value = totalClicks1 + totalClicks2 End If Next Debug.Print "Done!" End Sub 

从这开始。

在这里输入图像描述

运行这个。

 Option Explicit Sub wqewwqwqwq() With Worksheets("Sheet4") With .Range(.Cells(2, "A"), .Cells(.Rows.Count, "D").End(xlUp).Offset(0, -3)) With .SpecialCells(xlCellTypeBlanks) Debug.Print .Address(0, 0) .Offset(0, 3).FormulaR1C1 = "=SUMIFS(C4, C2, RC2, C1, ""<>"")" End With 'optionally revert formulas to values .Offset(0, 3).Value = .Offset(0, 3).Value2 End With End With End Sub 

结束了这一点。

在这里输入图像说明

你可以尝试这样的事情…下面的代码假定行1是标题行,其中列A是主题,列B是标题,列D是总点击。

 Sub GetTotalClicksTitleWise() Dim ws As Worksheet Dim lr As Long Dim rng As Range, cell As Range, vCell As Range Dim Title As String Dim TotalClick As Long Application.ScreenUpdating = False Set ws = ActiveSheet lr = ws.UsedRange.Rows.Count 'Assuming Column B is the Title Column Set rng = ws.Range("B2:B" & lr) For Each cell In rng If cell.Value <> Title Then Title = cell.Value With ws.Rows(1) .AutoFilter field:=2, Criteria1:=Title TotalClick = Application.Sum(ws.Range("D2:D" & lr).SpecialCells(xlCellTypeVisible)) For Each vCell In ws.Range("D2:D" & lr).SpecialCells(xlCellTypeVisible) If vCell.Value = 0 And ws.Cells(vCell.Row, "A") = "" Then vCell.Value = TotalClick Exit For End If Next vCell End With End If TotalClick = 0 Next cell ws.AutoFilterMode = False Application.ScreenUpdating = True End Sub 

作为一般规则,VBA中的速率限制步骤是在VBA和工作表之间传递值。 所以任何一行如

 .Range("MyRange").Cells(1,1).Value = "SomeValue" 

要么

 myVariable = .Range("MyRange").Cells(1,1).Value 

将是一个瓶颈。

正如YowE3K所提到的,将范围内的值读入一个变体。 它们将作为基础1,二维变体arrays复制到变体中。 然后处理数组。 然后,如果需要,您可以将结果重新放在表格上。

例如:

 Public Sub ProcessRange() Dim rngMyRange As Range Dim vntMyRangeValues As Variant Dim intRowCounter As Integer Dim intRowCount As Integer Dim strConcatenation As String Set rngMyRange = wksOne.Range("MyNamedRange") vntMyRangeValues = rngMyRange.Cells.Value intRowCount = UBound(vntMyRangeValues) For intRowCounter = 1 To intRowCount 'Some random processing to illustrate the point strConcatenation = CStr(vntMyRangeValues(intRowCounter, 1)) & " - " & CStr(vntMyRangeValues(intRowCounter, 2)) Debug.Print strConcatenation vntMyRangeValues(intRowCounter, 3) = strConcatenation Next 'the fast way to save the result values on the sheet rngMyRange.Cells.Value = vntMyRangeValues End Sub 

这种替代方法将从根本上加速任何不断从VBAvariables获取或设置值的循环。