VBA遍历列更新工作表列时仅更新首个单元格问题求助

问题根源 #

你的代码里rw = rw + 1仅放在最后一个ElseIf的分支中，意味着只有当单元格值为"xxxxxx"时，目标行号才会递增。其他匹配条件的情况都会重复写入Export工作表的第2行，后面的内容会覆盖前面的，最终只剩最后一次写入的内容留在第2行。

修复方案 #

方案1：修正行号递增位置

把rw = rw + 1移到整个If-ElseIf语句块的外面，确保每次匹配任意条件并写入后，行号都会自动递增：

Sub Update()
    Dim cell As Range, rw As Long
    rw = 2
    For Each cell In ActiveSheet.Range("J14:J33")
        If cell.Value = "xx" Then
            Worksheets("Export").Cells(rw, 14).Value = "xx"
        ElseIf cell.Value = "xxx" Then
            Worksheets("Export").Cells(rw, 14).Value = "xxx"
        ElseIf cell.Value = "xxxx" Then
            Worksheets("Export").Cells(rw, 14).Value = "xxxx"
        ElseIf cell.Value = "xxxxx" Then
            Worksheets("Export").Cells(rw, 14).Value = "xxxxx"
        ElseIf cell.Value = "xxxxxx" Then
            Worksheets("Export").Cells(rw, 14).Value = "xxxxxx"
        End If
        ' 无论是否匹配条件，都递增行号（若需跳过不匹配值，可移至If块内）
        rw = rw + 1
    Next
End Sub

如果只想处理匹配指定值的单元格，跳过空值或其他值，可改用Select Case简化判断：

Sub Update()
    Dim cell As Range, rw As Long
    rw = 2
    For Each cell In ActiveSheet.Range("J14:J33")
        Select Case cell.Value
            Case "xx", "xxx", "xxxx", "xxxxx", "xxxxxx"
                Worksheets("Export").Cells(rw, 14).Value = cell.Value
                rw = rw + 1
            ' 其他值不做处理
        End Select
    Next
End Sub

方案2：简化代码（更高效）

观察你的逻辑，本质是将原单元格的值直接复制到目标工作表，无需逐个判断，直接赋值即可：

Sub Update()
    Dim cell As Range, rw As Long
    rw = 2
    For Each cell In ActiveSheet.Range("J14:J33")
        ' 可选：仅复制指定值，去掉If则复制所有单元格内容
        If cell.Value = "xx" Or cell.Value = "xxx" Or cell.Value = "xxxx" Or cell.Value = "xxxxx" Or cell.Value = "xxxxxx" Then
            Worksheets("Export").Cells(rw, 14).Value = cell.Value
            rw = rw + 1
        End If
    Next
End Sub

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