循环遍历 2 列的范围

Question

我的问题得到了一遍又一遍的回答，但我不理解解决方案，因此无法根据我的需要定制它们。

这是 StackOverflow 上解决方案的链接Loop through each row of a range in Excel。

Dim rng As Range
Dim row As Range
Dim cell As Range

Set rng = Range("A2:b22")

For Each row In rng.Rows
  For Each cell in row.Cells
    'Do Something
MsgBox cell
  Next cell
Next row

这是我应该进入循环的代码。它应该取第一列的值，复制数据，然后取第二列的值并粘贴数据。

它所做的是使用第一列中的相同值。那么CELL的值在什么时候从A2变为B2呢？

Windows("UnitedOrig.xlsx").Activate
Sheets(CurYearTxtPRAC).Select
Range("A4:U4").Select

ColumnFROM = MyColumnLetter(Cells.Find(What:=cell, After:=ActiveCell,  
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,  
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column)

Range(ColumnFROM & "5:" & ColumnFROM & LastRowPRAC).Select
Selection.Copy

Windows("United.xlsx").Activate
Sheets("PRACS").Select
Range("A1:U1").Select

ColumnTO = MyColumnLetter(Cells.Find(What:=cell, After:=ActiveCell, 
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, 
    SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Column)

Answer 1

为了了解循环在做什么，您需要监控正在处理的内容。您可以通过更改单元格的颜色或为行添加边框来轻松做到这一点。

将这两个 sub 粘贴到一个模块中：

Sub WhereInDoubleLoop()
    Dim rng As Range
    Dim row As Range
    Dim cell As Range

    Set rng = Range("A1:D5")

    For Each row In rng.Rows
    ' Do something to the row
    row.BorderAround xlContinuous, xlThin, vbBlack
      For Each cell In row.Cells
        ' Do something to the cell
        cell.Interior.Color = vbYellow
      Next cell
    Next row
End Sub

---

Sub WhereInSingleLoop()
    Dim rng As Range
    Dim cell As Range

    Set rng = Range("A1:D5")

    For Each cell In rng
        ' Do something to the cell
        cell.Interior.Color = vbGreen
    Next cell
End Sub

单步执行每个循环（代码编辑器中的 F8），您应该可以更好地了解到底发生了什么。一旦你理解了它们，你就可以为你自己的循环修改它们。

Answer 2

我最近做了类似的事情（实际上我在两个不同的工作表上比较了多个单元格）并且是 VBA 的新手，但是我不是基于特定行/列号的循环而不是范围，我发现你没有需要 .Activate 来读取或写入或更改单元格（我使用的以下方法而不是 .Select/.Activate 使运行时间大约快 300-400%）。这是一些非常快速的伪类代码，希望它们应该有意义并且应该可以轻松修改为您需要的内容。

Dim oSheet As Excel.Worksheet, vSheet As Excel.Worksheet
Dim oRowCount As Integer, vRowCount As Integer
Dim oRow, vRow
Dim someDataToCopy As String

'Gets last row # for oSheet & vSheet    
oRowCount = oSheet.Cells.SpecialCells(xlLastCell).row
vRowCount = vSheet.Cells.SpecialCells(xlLastCell).row

For oRow = 2 to oRowCount
    someDataToCopy = oSheet.Cells(oRow, 4).Value 'Where 4 is an arbitrary column
    For vRow = 2 to vRowCount
        vSheet.Cells(vRow, 8).Value = someDataToCopy 'Where 8 is an arbitrary column
    Next vRow
Next oRow

如果您不只是每行复制一个单元格，而是每行复制多个单元格以及添加更多“= oSheet.Cells(oRow, x) .Value”根据需要。如果您对代码的作用有任何疑问，请告诉我！