循环更新列无法正常工作

Question

我有一个工作表，其中的数据分别位于Column A和Column B中，我想根据以下条件更新Column C： 在cellB中找到cellA，然后在cellB中匹配行的Column C中写入column A。 在社区的帮助下，我设法提出了一些建议，但 有人可以告诉我为什么下面的loop仅适用于几行吗？ 另外，有时Column B可以为空白，这是一个问题吗？如果是这样，如果空白，我可以跳过吗？

这可行（也许是因为所有单元格中都有数据）：

Option Explicit
Sub Button2_Click()
Dim cellB As Range
Dim cellA As Range

For Each cellB In Range("b2:b5")
For Each cellA In Range("a2:a5")
If InStr(cellA, cellB) > 0 Then
Range("c" & cellA.Row) = cellB
End If
Next cellA
Next cellB

End Sub

这会尝试更新Column C，但是cellB中的Column C值永远不会更新（也许是因为Column B包含空值？）：

Option Explicit
Sub Button2_Click()
Dim cellB As Range
Dim cellA As Range

For Each cellB In Range("b2:b500")
For Each cellA In Range("a2:a500")
If InStr(cellA, cellB) > 0 Then
Range("c" & cellA.Row) = cellB
End If
Next cellA
Next cellB
End Sub

工作表的快照：

Answer 1

请尝试这种方式，请。它将基于A：A列填充范围来处理所有现有范围。它使用数组来收集处理结果，并且应该足够快：

Dim cellB As Range, cellA As Range, sh As Worksheet, lastRow As Long
Dim arrfin As Variant

 Set sh = ActiveSheet 'use here your necessary sheet
 lastRow = sh.Range("A" & Rows.count).End(xlUp).row
 ReDim arrfin(1 To lastRow, 1 To 1)

 sh.Range("C:C").Clear
 For Each cellA In Range("a2:a" & lastRow)
    For Each cellB In Range("b2:b" & lastRow)
        If cellA.value <> "" And cellB.value <> "" Then
            If InStr(cellA.value, cellB.value) > 0 Then
                arrfin(cellA.row, 1) = cellB.value
            End If
        End If
    Next cellB
 Next cellA
 sh.Range("C1").Resize(UBound(arrfin, 1), UBound(arrfin, 2)).value = arrfin

Answer 2

“下一个”与“下一个”的壮举。 “范围”与“单元格”

• 所有五个示例都做同样的事情。
• 最好将它们复制到标准模块（例如Module1）中，然后轻松地从 VBE 运行或通过按钮单击事件调用，例如

---

Option Explicit
Sub Button2_Click()
    Call updateForEachNextCellsVersion
    ' or just:
    updateForEachNextCellsVersion 
End Sub

---

• 有两个 For 循环：For Next循环和For Each Next循环。
• 前两个示例使用For Each Next循环，而其余两个示例使用For Next循环。
• 第一个和第三个示例使用Cells，而第二个和第四个示例使用Range。
• 当Cells非常容易使用时，为什么还要使用Range？你们两个都知道Range的最大缺点是您无法遍历一行以增加列数。对于此任务，只能使用Cells。
• 第5个示例显示了Cells与列号的使用。

代码

Option Explicit

Sub updateForEachNextCellsVersion()
    
    ' Calculate the row of the last non-blank cell in column A.
    Dim LastRow As Long: LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Declare the cell ranges for column A and B.
    Dim celA As Range, celB As Range
    ' Loop through rows of column A.
    For Each celA In Range(Cells(2, "A"), Cells(LastRow, "A")).Cells
        ' Loop through rows of column B.
        For Each celB In Range(Cells(2, "B"), Cells(LastRow, "B")).Cells
            ' Check if the current cell in column B is not blank.
            If Not IsEmpty(celB) Then
                ' Check if the values of the current cells in columns A and B
                ' are equal.
                If celA.Value = celB.Value Then
                    ' Write value of current cell in column B to
                    ' column C, to the row of current cell in column A.
                    Cells(celA.Row, "C").Value = celB.Value
                End If
            End If
        Next celB
    Next celA
    
End Sub

Sub updateForEachNextRangeVersion()
    
    ' Calculate the row of the last non-blank cell in column A.
    Dim LastRow As Long: LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    ' Declare the cell ranges for column A and B.
    Dim celA As Range, celB As Range
    ' Loop through rows of column A.
    For Each celA In Range("A2:A" & LastRow).Cells
    ' or: For Each celA In Range("A2", "A" & LastRow).Cells
        ' Loop through rows of column B.
        For Each celB In Range("B2:B" & LastRow).Cells
        ' or: For Each celB In Range("B2", "B" & LastRow).Cells
            ' Check if the current cell in column B is not blank.
            If Not IsEmpty(celB) Then
                ' Check if the values of the current cells in columns A and B
                ' are equal.
                If celA.Value = celB.Value Then
                    ' Write value of current cell in column B to
                    ' column C, to the row of current cell in column A.
                    Range("C" & celA.Row).Value = celB.Value
                End If
            End If
        Next celB
    Next celA
    
End Sub

Sub updateForNextCellsVersion()
    
    ' Calculate the row of the last non-blank cell in column A.
    Dim LastRow As Long: LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Declare the counters for the loops (i for column A, j for column B).
    Dim i As Long, j As Long
    ' Loop through rows of column A.
    For i = 2 To LastRow
        ' Loop through rows of column B.
        For j = 2 To LastRow
            ' Check if the current cell in column B is not blank.
            If Not IsEmpty(Cells(j, "B")) Then
                ' Check if the values of the current cells in columns A and B
                ' are equal.
                If Cells(i, "A").Value = Cells(j, "B").Value Then
                    ' Write value of current cell in column B to
                    ' column C, to the row of current cell in column A.
                    Cells(i, "C").Value = Cells(j, "B").Value
                End If
            End If
        Next j
    Next i
    
End Sub

Sub updateForNextRangeVersion()
    
    ' Calculate the row of the last non-blank cell in column A.
    Dim LastRow As Long: LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    ' Declare the counters for the loops (i for column A, j for column B).
    Dim i As Long, j As Long
    ' Loop through rows of column A.
    For i = 2 To LastRow
        ' Loop through rows of column B.
        For j = 2 To LastRow
            ' Check if the current cell in column B is not blank.
            If Not IsEmpty(Range("B" & j)) Then
                ' Check if the values of the current cells in columns A and B
                ' are equal.
                If Range("A" & i).Value = Range("B" & j).Value Then
                    ' Write value of current cell in column B to
                    ' column C, to the row of current cell in column A.
                    Range("C" & i).Value = Range("B" & j).Value
                End If
            End If
        Next j
    Next i
    
End Sub

Sub updateForNextCellsColumnNumbersVersion()
    
    ' Calculate the row of the last non-blank cell in column A.
    Dim LastRow As Long: LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    ' Declare the counters for the loops (i for column A, j for column B).
    Dim i As Long, j As Long
    ' Loop through rows of column A.
    For i = 2 To LastRow
        ' Loop through rows of column B.
        For j = 2 To LastRow
            ' Check if the current cell in column B is not blank.
            If Not IsEmpty(Cells(j, 2)) Then
                ' Check if the values of the current cells in columns A and B
                ' are equal.
                If Cells(i, 1).Value = Cells(j, 2).Value Then
                    ' Write value of current cell in column B to
                    ' column C, to the row of current cell in column A.
                    Cells(i, 3).Value = Cells(j, 2).Value
                End If
            End If
        Next j
    Next i
    
End Sub