为何这段VBA代码无法写入或更新新工作表的记录？

架构老林

2026-7-28

代码问题排查与修复

先直接说你代码里的致命错误：

列判断逻辑完全错误：原代码里的If Target.Row < 2 Or (Target.Column <> 31 Or Target.Column <> 32 Or Target.Column <> 33 Or Target.Column <> 34) Then Exit Sub，用Or的话，任何列都会触发Exit Sub——比如你改AE列（31列），Target.Column <>32是真，整个Or表达式为真，代码直接退出，根本不会执行后面的逻辑。要改成用And：
```
If Target.Row < 2 Or (Target.Column <> 31 And Target.Column <> 32 And Target.Column <> 33 And Target.Column <> 34) Then Exit Sub
```
或者更清晰的写法：
```
If Target.Row < 2 Or Not (Target.Column >= 31 And Target.Column <= 34) Then Exit Sub
```
MsgBox语句语法错误：MsgBox后面没有参数，会直接编译报错，要么删掉这行，要么改成MsgBox "匹配检查完成"之类的合法语句。

接下来是通用排查步骤：

先过语法关：打开VBE（Alt+F11），点击菜单栏「调试」→「编译VBAProject」，所有语法错误（比如缺参数、变量未定义）都会直接提示，先把这些问题Fix掉。
断点逐行调试：
1. 在代码第一行Set wsComments = ...左边点击加断点（出现红圆点）；
2. 回到Excel修改AE/AF/AG/AH列的单元格，代码会自动停在断点处；
3. 按F8逐行执行，同时看「本地窗口」（如果没显示就按Ctrl+G）里的变量值：
  - 确认Target.Row和Target.Column是你修改的单元格的行和列；
  - 确认wsComments和wsQuery1确实指向了正确的工作表；
  - 跟踪foundMatch的取值，看循环里有没有找到匹配的记录；
  - 看lastRow是否正确获取了Comments表A列的最后一行数据行。
检查值的匹配问题：如果循环没找到匹配，可能是单元格值看起来一样但实际不同（比如有空格、大小写差异、文本/数值格式不同）。可以在循环里加一行调试输出：
```
Debug.Print "对比：" & wsComments.Cells(i, "A").Value & " | " & wsQuery1.Cells(Target.Row, "C").Value
```
执行后按Ctrl+G打开立即窗口，看两边的值是不是完全一致。
处理多单元格触发场景：如果一次性修改多个单元格（比如粘贴），Target会是一个多单元格区域，Target.Row只取第一个单元格的行，会导致逻辑混乱。可以在开头加判断：
```
If Target.Cells.Count > 1 Then Exit Sub
```
核对工作表名称：确保你的工作簿里确实有叫「Comments」和「Query1」的工作表，没有拼写错误（比如少了s、大小写不对）。

修正后的完整代码参考：

Private Sub Query1_Change(ByVal Target As Range)
    Dim wsComments As Worksheet
    Dim wsQuery1 As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim foundMatch As Boolean
    
    ' 处理多单元格修改的情况
    If Target.Cells.Count > 1 Then Exit Sub
    
    Set wsComments = ThisWorkbook.Sheets("Comments")
    Set wsQuery1 = ThisWorkbook.Sheets("Query1")
    
    ' 只处理第2行及以下的AE(31)/AF(32)/AG(33)/AH(34)列
    If Target.Row < 2 Or Not (Target.Column >= 31 And Target.Column <= 34) Then Exit Sub
    
    foundMatch = False
    ' 检查Comments表A列是否有匹配的记录
    lastRow = wsComments.Cells(wsComments.Rows.Count, "A").End(xlUp).Row
    ' 处理Comments表A列没有数据的情况（lastRow=1）
    For i = 2 To IIf(lastRow >=2, lastRow, 1)
        If wsComments.Cells(i, "A").Value = wsQuery1.Cells(Target.Row, "C").Value Then
            foundMatch = True
            Exit For
        End If
    Next i
    
    If Not foundMatch Then
        ' 新增记录
        lastRow = wsComments.Cells(wsComments.Rows.Count, "A").End(xlUp).Row + 1
        wsComments.Cells(lastRow, "A").Value = wsQuery1.Cells(Target.Row, "C").Value
        wsComments.Cells(lastRow, "B").Value = wsQuery1.Cells(Target.Row, "AE").Value
        wsComments.Cells(lastRow, "C").Value = wsQuery1.Cells(Target.Row, "AF").Value
        wsComments.Cells(lastRow, "D").Value = wsQuery1.Cells(Target.Row, "AG").Value
        wsComments.Cells(lastRow, "E").Value = wsQuery1.Cells(Target.Row, "AH").Value
    Else
        ' 更新现有记录
        wsComments.Cells(i, "B").Value = wsQuery1.Cells(Target.Row, "AE").Value
        wsComments.Cells(i, "C").Value = wsQuery1.Cells(Target.Row, "AF").Value
        wsComments.Cells(i, "D").Value = wsQuery1.Cells(Target.Row, "AG").Value
        wsComments.Cells(i, "E").Value = wsQuery1.Cells(Target.Row, "AH").Value
    End If
    
End Sub

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