vba - 使用 VBA，是否有更有效的方法来遍历 Excel 中的行，然后在该循​​环中再循环抛出两次？

Question

我的电子表格有几千行。其中一些行需要在它们之间合并一些数据。我可以通过特定列中没有值来识别这些行。找到该行后，我需要搜索两个 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           |

Title 列中以“title 1”开头的行是匹配行。我需要从“总点击次数”列中获取点击次数，将它们加在一起，然后将其添加到没有主题值的行的匹配单元格中。例如，“标题 1”的行当前的总点击次数为 0。宏运行后，它会显示 230，因为我会将 110 添加到 120。

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

我目前正在测试这段代码，其范围共有 37 列和 3,624 行。完成所需的时间有点疯狂。我能做些什么来加快这个过程吗？我的代码如下。

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

Answer 1

从这个开始。



运行这个。

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

结束这个。