VBA实现表单工作表数据更新至另一数据表时Update宏报错求解

问题描述 #

自学VBA两周，在Sheet1中通过形状+单元格制作了交互表单，用于操作名为Data的专用数据表，实现记录插入、更新、新建功能。目前除更新按钮绑定的Update宏外，其余功能均可正常运行，运行Update宏时会弹出无法识别含义的报错。

全局变量声明：

Public Upda As String

原有问题代码 #

Sub Search()
    '
    ' Search Macro
    '
    Dim Sheet As String, ans


    On Error GoTo Erro:

    Data.Activate


    Sheet = Data.Name

    ans = InputBox("Write down the ID", "Search")

    If ans = "" Then
    Sheet1.Activate
    Exit Sub
    End If
    Dim C
    With Worksheets(Data).Range("A:A")

    Set C = .Find(ans, LookIn:=xlValues, lookat:=xlWhole)

    If Not C Is Nothing Then

     C.Activate
     Sheet1.Cells(17, 9).Value = C.Value ' Id
     Sheet1.Cells(9, 4).Value = C.Offset(0, 1).Value ' Name
     ' here goes the other fields to be inserted
     Sheet1.Activate

     Upda = Sheet1.Cells(17, 9).Text
    Else

    Sheet1.Activate
    MsgBox "Insert a valid ID", vbCritical, "Search"


    End If

    End With

    Exit Sub
Erro:
        MsgBox "Something went wrong, contact the Adm!", vbCritical, "Erro"
  
End Sub

   
'Update macro need to get a fix
Sub Update()

'update macro

Dim Sheet As String


On Error GoTo Erro
If IsEmpty(Range("I17")) Or IsEmpty(Range("D9"))  Then ' there are more fields to validate
  MsgBox "All the fields must have a value", vbExclamation, "Upda"

If Upda = "" Then

 MsgBox "Please retry the search", vbExclamation, "Update"
Exit Sub
End If
Dim C
'
Data.Activate

Sheet = Data.Name

With Worksheets(Sheet).Range("A:A")

    Set C = .Find(Upda, LookIn:=xlValues, lookat:=xlWhole)

If Not C Is Nothing Then

    C.Activate

    ActiveCell.Value = Sheet1.Cells(17, 9).Text ' ID
    ActiveCell.Offset(0, 1).Value = Sheet1.Cells(9, 4).Text   ' Name
  'Update the table with the contents of the form1
    
    Sheet1.Activate
    Range("I6:J6").ClearContents
         ' remaining code to clear the contents of the form sheet1
    Upda = ""

    'Call clear
Else
MsgBox "ID number not found", vcCritical, "Update"

End If
End With


Exit Sub
Erro:
MsgBox "Something went wrong, contact the Adm!", vbCritical, "ERRO"
End Sub

Sub clear()
'
' clear Macro
'
    Range("I17").ClearContents
    ' remaining code to cleear the contents of the form sheet1
    Upda = ""
End Sub

故障原因 #

• 语法结构错误：Update过程中校验必填字段的If块未添加对应的End If，后续判断Upda变量的逻辑嵌套错位，直接触发编译错误
• 常量拼写错误：提示ID不存在的MsgBox代码中，将VBA内置常量vbCritical错写为vcCritical，漏写字母b
• 引用不规范：大量使用Activate切换活动工作表、Range对象未显式指定所属工作表，容易出现范围指向错误；Worksheets参数引用不规范，存在隐式调用风险
• 错误捕获逻辑过于宽泛：所有错误统一跳转至通用提示，无法暴露具体报错位置

修复后完整代码 #

Public Upda As String

Sub Search()
    Dim wsData As Worksheet
    Dim ans As Variant
    Dim C As Range

    On Error GoTo Erro
    Set wsData = ThisWorkbook.Worksheets("Data")

    ans = InputBox("Write down the ID", "Search")
    If ans = "" Then
        Sheet1.Activate
        Exit Sub
    End If

    With wsData.Range("A:A")
        Set C = .Find(ans, LookIn:=xlValues, lookat:=xlWhole)
        If Not C Is Nothing Then
            Sheet1.Cells(17, 9).Value = C.Value ' ID
            Sheet1.Cells(9, 4).Value = C.Offset(0, 1).Value ' Name
            ' 其余字段赋值逻辑可在此处补充
            Upda = Sheet1.Cells(17, 9).Text
        Else
            MsgBox "Insert a valid ID", vbCritical, "Search"
        End If
    End With

    Sheet1.Activate
    Exit Sub
Erro:
    MsgBox "Something went wrong, contact the Adm!", vbCritical, "Erro"
End Sub

Sub Update()
    Dim wsData As Worksheet
    Dim C As Range

    On Error GoTo Erro
    Set wsData = ThisWorkbook.Worksheets("Data")

    ' 校验必填字段
    If IsEmpty(Sheet1.Range("I17")) Or IsEmpty(Sheet1.Range("D9")) Then
        MsgBox "All the fields must have a value", vbExclamation, "Upda"
        Exit Sub
    End If

    ' 校验是否已通过搜索定位待更新记录
    If Upda = "" Then
        MsgBox "Please retry the search", vbExclamation, "Update"
        Exit Sub
    End If

    With wsData.Range("A:A")
        Set C = .Find(Upda, LookIn:=xlValues, lookat:=xlWhole)
        If Not C Is Nothing Then
            ' 更新匹配行数据
            C.Value = Sheet1.Cells(17, 9).Text ' ID
            C.Offset(0, 1).Value = Sheet1.Cells(9, 4).Text ' Name
            ' 其余字段更新逻辑可在此处补充

            ' 清空表单
            Sheet1.Range("I6:J6").ClearContents
            Call clear
        Else
            MsgBox "ID number not found", vbCritical, "Update"
        End If
    End With

    Exit Sub
Erro:
    MsgBox "Something went wrong, contact the Adm!", vbCritical, "ERRO"
End Sub

Sub clear()
    Sheet1.Range("I17").ClearContents
    ' 其余表单清空逻辑可在此处补充
    Upda = ""
End Sub

修复说明 #

• 补全所有If判断块的闭合结构，将必填项校验、搜索状态校验拆分为独立判断逻辑，不符合条件时直接退出过程，避免执行后续错误逻辑
• 修正MsgBox常量拼写错误
• 替换原有频繁Activate工作表的写法，显式定义工作表对象，所有单元格/范围调用都明确指定所属工作表，避免活动工作表切换导致的引用错误
• 调整表单清空逻辑，直接调用已写好的clear过程，避免重复代码

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