将“For”转换为“For each”循环
我有一些VBA代码查看工作表中行的列D和E中的其他条目实例的最后一个新行。 当find两个列实例时，macros将现有行的列F中的数据复制到新行的F列。
然而，这个macros在发现这个第一个事件之后会结束。 我想macros循环，直到find所有的实例。
我想最好的办法是将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
对，从Jean-FrançoisCorbett的答案开始 ，它在存储数组之前先保存数组中的内容，然后将其调整为以自下而上的顺序检查所有重复行。 你得到这样的东西：
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来确定已经处理的行只是简单的节省了处理时间。 这并不是必须的，因为这个过程的底部到顶部的行为将会取代未来的重复行数值，同时重复数据更less。 只是它会做更换多次，每进一步复制页面。 rowAltered检查防止这一点。
如果您将数据保留在电子表格中，则可以使用.Find()方法来定位重复项而不是内部循环。 但我怀疑这会更有效率。
我看不出有什么理由在你的情况下转移到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
我会这样说
-
顺序处理一个列表 – 特别是退出条件 – 更好地完成与古典循环（
Do/Loop，While，For/Next） -
使用
For Each ... In / Next你需要有一个集合（比如范围，表单列表 – 任何以' s '结尾的东西），并且要记住不能保证这个列表是自顶向下处理的左 – 右…没有预定义的或可选的序列。
所以根据你描述的逻辑，我没有看到改变For/Next For Each ... In/Next 。
您需要跟踪新的行，以便每次find重复的行时，都会将新的行增加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