如何将Excel UserForm修改数据的VBA代码从列引用改为表名引用？

我正在通过UserForm向Excel表格添加和修改数据，点击ListBox中的任意项目时，所有TextBox会自动填充对应数据。但当前修改按钮（CmdUpdate）的VBA代码是通过列标（如"A"、"J"）来引用单元格的，我希望调整为通过Excel表（ListObject）的表名和列名来引用，提升代码的可维护性。

当前使用的代码如下：

Private Sub CmdUpdate_Click()

Dim zz As Range
Dim rr As Range
Dim c As Range
Dim old_name, new_name, fname, new_mr, fmr

Dim EditRow As Cells

Set editBev = Data.ListObjects("T_Beverage")


ThisWorkbook.Activate

If Me.comDepartment.Text = "" Or Me.txtItemName.Text = "" Or Me.txtPrice.Text = "" _
  Or Me.comUnit.Text = "" Then
MsgBox "Please enter data  ", vbCritical, "Inventory program "
Exit Sub
End If

Set ww = Application.WorksheetFunction


old_name = Me.TxtEditItem.Value
new_name = Me.txtItemName.Text
'===== no change in name
If new_name = old_name Then GoTo 5

fname = ww.CountIf(Data.Range("T_Food[[Item Name]]"), new_name)
fname = ww.CountIf(Data.Range("T_Beverage[[#All],[Item Name]]"), new_name)
fname = ww.CountIf(Data.Range("T_Other[[#All],[Item Name]]"), new_name)

If fname >= 1 Then: MsgBox "  This name already exists  ", vbCritical, "Inventory Program ": Exit Sub
'==========================

5 Application.ScreenUpdating = False

  Application.Calculation = xlCalculationManual
  
'==change in data table====
With Data
.Unprotect ("0000")

If Me.comDepartment.Value = "Food" Then

For Each c In Data.Range("T_Food[[#All],[Item Name]]") 
If old_name = c Then GoTo 1
Next
1 LastRow = c.Row

.Cells(LastRow, "A").Value = Me.txtCode.Text
.Cells(LastRow, "B").Value = new_name
.Cells(LastRow, "C").Value = Me.txtCode.Text
.Cells(LastRow, "D").Value = Me.comUnit.Text
.Cells(LastRow, "E").Value = Me.txtPrice.Text '
.Cells(LastRow, "F").Value = Me.TxtSalePrice.Text
.Cells(LastRow, "H").Value = Me.comDepartment.Text

.Protect Password:=("0000")

Application.Calculation = xlCalculationAutomatic
Me.TxtEditItem.Value = new_name
End If
If Me.comDepartment.Value = "Beverage" Then

For Each c In Data.Range("T_Beverage[[Item Name]]") 

If old_name = c Then GoTo 2
Next
2 LastRow = c.Row

.Cells(LastRow, "J").Value = Me.txtCode.Text
.Cells(LastRow, "K").Value = new_name
.Cells(LastRow, "K").Value = Me.txtCode.Text
.Cells(LastRow, "M").Value = Me.comUnit.Text
.Cells(LastRow, "N").Value = Me.txtPrice.Text '
.Cells(LastRow, "O").Value = Me.TxtSalePrice.Text
.Cells(LastRow, "Q").Value = Me.comDepartment.Text

.Protect Password:=("0000")

Application.Calculation = xlCalculationAutomatic
Me.TxtEditItem.Value = new_name
End If
End With
Application.ScreenUpdating = True
End Sub

重构后通过表名引用的代码 #

Private Sub CmdUpdate_Click()
    Dim targetTable As ListObject
    Dim oldName As String, newName As String
    Dim matchRow As ListRow
    Dim ws As Worksheet
    Dim nameCount As Long
    
    ' 绑定目标工作表
    Set ws = ThisWorkbook.Worksheets("Data")
    
    ' 必填项校验
    If Me.comDepartment.Text = "" Or Me.txtItemName.Text = "" Or Me.txtPrice.Text = "" Or Me.comUnit.Text = "" Then
        MsgBox "请填写完整数据", vbCritical, "库存管理程序"
        Exit Sub
    End If
    
    oldName = Me.TxtEditItem.Value
    newName = Me.txtItemName.Text
    
    ' 跨表检查名称重复
    If newName <> oldName Then
        nameCount = Application.WorksheetFunction.CountIf(ws.ListObjects("T_Food").ListColumns("Item Name").DataBodyRange, newName) _
                  + Application.WorksheetFunction.CountIf(ws.ListObjects("T_Beverage").ListColumns("Item Name").DataBodyRange, newName) _
                  + Application.WorksheetFunction.CountIf(ws.ListObjects("T_Other").ListColumns("Item Name").DataBodyRange, newName)
        
        If nameCount >= 1 Then
            MsgBox "该名称已存在", vbCritical, "库存管理程序"
            Exit Sub
        End If
    End If
    
    ' 根据部门选择对应的数据表
    Select Case Me.comDepartment.Value
        Case "Food"
            Set targetTable = ws.ListObjects("T_Food")
        Case "Beverage"
            Set targetTable = ws.ListObjects("T_Beverage")
        Case Else
            MsgBox "无效的部门选择", vbExclamation, "库存管理程序"
            Exit Sub
    End Select
    
    ' 快速查找目标行
    On Error Resume Next
    Set matchRow = targetTable.ListColumns("Item Name").DataBodyRange.Find(What:=oldName, LookIn:=xlValues, LookAt:=xlWhole).EntireRow.ListObject.ListRow
    On Error GoTo 0
    
    If matchRow Is Nothing Then
        MsgBox "未找到要修改的记录", vbExclamation, "库存管理程序"
        Exit Sub
    End If
    
    ' 关闭屏幕更新与自动计算提升性能
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' 修改表中数据
    ws.Unprotect Password:="0000"
    With matchRow
        .Range(targetTable.ListColumns("Code").Index).Value = Me.txtCode.Text
        .Range(targetTable.ListColumns("Item Name").Index).Value = newName
        .Range(targetTable.ListColumns("Code").Index).Value = Me.txtCode.Text
        .Range(targetTable.ListColumns("Unit").Index).Value = Me.comUnit.Text
        .Range(targetTable.ListColumns("Price").Index).Value = Me.txtPrice.Text
        .Range(targetTable.ListColumns("Sale Price").Index).Value = Me.TxtSalePrice.Text
        .Range(targetTable.ListColumns("Department").Index).Value = Me.comDepartment.Text
    End With
    ws.Protect Password:="0000"
    
    ' 恢复系统默认设置
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    ' 更新编辑框显示名称
    Me.TxtEditItem.Value = newName
End Sub

关键改动说明 #

• 表名+列名定位：通过ListObject.ListColumns("列名").Index获取列位置，彻底摆脱对"A"、"J"这类硬编码列标的依赖，表格结构调整时无需修改代码
• 统一查找逻辑：用Find方法替代循环遍历，高效定位目标行，代码更简洁易读
• 减少重复代码：通过Select Case统一获取目标表，后续修改逻辑复用同一套代码，避免重复编写分支逻辑
• 补全代码完整性：原代码遗漏End With和Application.ScreenUpdating = True，重构后补上确保代码规范
• 增加错误处理：添加未找到记录的判断，避免运行时错误

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