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           |

“标题”列中以“标题1”开头的行是匹配的行。我需要从“Total Clicks”列中获取点击，将它们添加到一起，然后将其添加到没有主题值的行的匹配单元格中。例如，具有“标题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

结束这一点。

Answer 2

您可以尝试这样的事情...... 下面的代码假定Row1是标题行，其中列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

Answer 3

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

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

或

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

将成为瓶颈。

正如YowE3K所提到的，将范围中的值读入变量。它们将被复制到变体中作为基础1，二维变体数组。然后处理数组。然后，如果需要，您可以在工作表上重新设置结果。

例如：

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

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

使用VBA，是否有更有效的方法在Excel中循环遍历行，然后循环从该循环中再循环两次？

3 个答案: