Question

我有一些VBA代码，用于查看工作表中某行的D列和E列中其他条目实例的最后一个新行。找到两个列实例时，宏将数据从现有行的列F复制到新行的列F.

然而，宏是限制性的，因为它在找到第一个实例后结束。我希望宏循环直到找到所有实例。

我认为最好的方法是将For循环转换为For each循环但似乎无法使任何代码尝试工作。任何指针都会非常有用！

Sub test()
    Dim N As Long
    N = Cells(Rows.Count, "D").End(xlUp).Row
    Dim i As Long
    d = Cells(N, "D").Value
    e = Cells(N, "E").Value

    For i = N - 1 To 1 Step -1
        dt = Cells(i, "D").Value
        et = Cells(i, "E").Value

        If d = dt And e = et Then
            Cells(N, "F").Value = Cells(i, "F").Value
        End If
    Next i         
End Sub

Answer 1

在我看来，我认为没有理由转到For Each。

你应该做的是立即读取表格中的所有内容，然后遍历这些数组。它比循环细胞更有效。写入工作表同样如此 - 这是缓慢而低效的。只需编写一次最终结果，而不是重复写入工作表。

示例：

Sub test()
    Dim d, e, dt, et, ft, x
    Dim i As Long
    Dim N As Long

    'Read everything from sheet into arrays
    N = Cells(Rows.Count, "D").End(xlUp).Row
    d = Cells(N, "D").Value
    e = Cells(N, "E").Value
    dt = Range("D1").Resize(N, 1).Value
    et = Range("E1").Resize(N, 1).Value
    ft = Range("F1").Resize(N, 1).Value

    'Loop through arrays
    For i = N - 1 To 1 Step -1
        If d = dt(i, 1) And e = et(i, 1) Then
            x = ft(i, 1)
        End If
    Next i

    'Write result back to sheet
    Cells(N, "F").Value = x
End Sub

Answer 2

我会说那个

按顺序处理列表 - 尤其是退出条件 - 最好使用经典循环（Do/Loop，While，For/Next）
使用For Each ... In / Next你需要有一个集合（如范围，工作表列表 - 以' s '结尾的任何内容），并记住它是不保证此列表是自上而下左右处理的...没有预定义或可选择的序列。

因此，根据您描述的逻辑，我认为没有必要将For/Next更改为For Each ... In/Next。

Answer 3

是的，从Jean-François Corbett's answer开始工作，它在继续提高效率之前将内容存储在数组中，但是将其调整为以渐进方式自下而上检查所有重复行。你得到这样的东西：

Public Sub FillDuplicates()
    Dim lastRow As Integer
    Dim dColumn As Variant, eColumn As Variant, fColumn As Variant
    Dim rowAltered() As Boolean

    'Find the last row in Column D with content
    lastRow = Cells(Rows.Count, "D").End(xlUp).Row

    'Acquire data from columns: D, E & F in to arrays
    dColumn = Range("D1").Resize(lastRow, 1).Value
    eColumn = Range("E1").Resize(lastRow, 1).Value
    fColumn = Range("F1").Resize(lastRow, 1).Value

    ReDim rowAltered(1 To lastRow)

    'Loop through all rows from bottom to top, using each D/E column value as a key
    For cKeyRow = lastRow To 1 Step -1

        'Ignore rows that have already been replaced
        If Not rowAltered(cKeyRow) Then

            'Loop through all rows above current key row looking for matches
            For cSearchRow = cKeyRow To 1 Step -1

                'If the row is a match and has not previously been changed, alter it
                If Not rowAltered(cSearchRow) And dColumn(cKeyRow, 1) = dColumn(cSearchRow, 1) And eColumn(cKeyRow, 1) = eColumn(cSearchRow, 1) Then
                    fColumn(cSearchRow, 1) = fColumn(cKeyRow, 1)
                    rowAltered(cSearchRow) = True
                End If

            Next cSearchRow

        End If

    Next cKeyRow

    'Store the amended F column back in the spreadsheet
    Range("F1").Resize(lastRow, 1) = fColumn
End Sub

注意，使用rowAltered确定已处理行的所有工作只会节省处理时间。没有必要，因为该过程的自下而上的行动将替换未来的关键行值，并且重复次数越低。只是它会为页面上的每个进一步复制多次替换。 rowAltered检查会阻止此操作。

如果您将数据留在电子表格中，那么您可以在列上使用.Find()方法来查找重复项，而不是内部循环。但我怀疑它会更有效率。

Answer 4

您需要跟踪新的行，以便每次找到重复行时，都会将新行增加1.要扩展代码：

Sub test()
    Dim N As Long
    Dim CurRow As Long
    N = Cells(Rows.Count, "D").End(xlUp).Row
    CurRow = N
    Dim i As Long
    d = Cells(N, "D").Value
    e = Cells(N, "E").Value

    For i = N - 1 To 1 Step -1
        dt = Cells(i, "D").Value
        et = Cells(i, "E").Value

        If d = dt And e = et Then
            Cells(CurRow, "F").Value = Cells(i, "F").Value
            CurRow = CurRow + 1
        End If
    Next i         
End Sub

将'For'转换为'For each'循环

4 个答案: