Excel列查找指定值的VBA代码异常：循环重复写入问题排查

先帮你拆解下当前代码里的几个核心问题，以及对应的修复方案：

一、当前代码的关键问题 #

• 查找字符串未加引号：你写的what:=January里，January没有被引号包裹，VBA会把它当作一个未定义的变量，而不是要查找的字符串"January"，这会直接导致查找逻辑失效或者报错。
• 逻辑完全不符合需求：你的目标是复制左侧相邻单元格的内容，但代码里却执行了FoundCell.Value = "Testing"——这不仅没有完成复制操作，还修改了原查找列的单元格值，这会干扰后续的FindNext查找，导致循环异常（比如修改后的单元格可能被再次匹配，陷入无限循环）。
• 无效的收尾代码：循环结束后Set rng = FoundCell这行完全没用，此时FoundCell大概率是Nothing，反而可能引发错误。
• 未处理目标写入位置：你提到的“在列末尾持续写入”，当前代码没有定位到目标列的最后一行，而是直接修改了找到的单元格，这完全偏离了需求。

二、修正后的代码（符合你的需求） #

下面是调整后的代码，我加上了详细注释，确保逻辑匹配你的需求：

Sub CopyAdjacentForJanuary()
    Dim fnd As String, firstFound As String
    Dim foundCell As Range
    Dim targetLastRow As Long
    Dim searchRange As Range
    
    ' 设置要查找的字符串
    fnd = "January"
    ' 定义要查找的范围（这里用B列，你可以根据需要调整）
    Set searchRange = ThisWorkbook.ActiveSheet.Range("B:B")
    
    ' 第一次查找：基于单元格值（xlValues），从最后一个单元格开始，循环查找第一个匹配项
    Set foundCell = searchRange.Find(what:=fnd, after:=searchRange.Cells(searchRange.Cells.Count), _
        LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
    
    If Not foundCell Is Nothing Then
        firstFound = foundCell.Address
        Do
            ' 找到匹配项后，先定位目标列的最后一行（这里假设你要写入到C列，可自行修改）
            targetLastRow = ThisWorkbook.ActiveSheet.Cells(Rows.Count, "C").End(xlUp).Row + 1
            ' 复制左侧相邻单元格（A列）的内容到目标列的末尾
            ThisWorkbook.ActiveSheet.Cells(targetLastRow, "C").Value = foundCell.Offset(0, -1).Value
            
            ' 查找下一个匹配项
            Set foundCell = searchRange.FindNext(foundCell)
        ' 循环终止条件：找不到匹配项，或者回到第一个找到的单元格（避免无限循环）
        Loop While Not foundCell Is Nothing And foundCell.Address <> firstFound
        MsgBox "已完成所有匹配项的复制！"
    Else
        MsgBox "未找到任何值为""January""的单元格！"
    End If
    
    ' 释放对象
    Set foundCell = Nothing
    Set searchRange = Nothing
End Sub

三、关键调整说明 #

• 明确查找字符串：用fnd = "January"定义查找目标，避免变量混淆。
• 基于值查找：保留LookIn:=xlValues，确保是查找单元格显示的值而非公式。
• 正确处理写入位置：每次找到匹配项时，先通过End(xlUp)定位目标列的最后一行，确保内容追加到列末尾，而不是修改原查找单元格。
• 避免循环异常：因为没有修改原查找列的内容，FindNext可以正常遍历所有匹配项，加上foundCell.Address <> firstFound的判断，防止无限循环。
• 指定工作表：用ThisWorkbook.ActiveSheet明确操作的工作表，避免因当前工作表切换导致的错误（也可以改成具体工作表名，比如Sheets("Sheet1")）。

内容的提问来源于stack exchange，提问作者KL_