VBA扩展需求：实现关联表格循环匹配并更新指定数据

现有如下VBA代码已实现通过用户窗体输入值，更新工作表PL2_steel内表格Tbl_spl2elements的数据，运行正常：

Private Sub but_spl1update_Click()

    Dim sh2 As Worksheet
    Set sh2 = ThisWorkbook.Sheets("PL2_steel")
    
    Dim tbl2 As ListObject
    Set tbl2 = sh2.ListObjects("Tbl_spl2elements")

    Dim x2 As Long
    x2 = FirstEmptyColumnRow(tbl2, 1)
 
     For y = 1 To x2
            If tbl2.DataBodyRange(y, 2).Value = Combo_spl1load.Value Then
            tbl2.DataBodyRange(y, 3).Value = Txt_spl1totalgwp2.Value
            tbl2.DataBodyRange(y, 5).Value = val(tbl2.DataBodyRange(y, 4).Value) * val(Txt_spl1totalgwp2.Value)
            End If
     Next y
     

 End Sub

扩展需求 #

需要新增关联表格的更新逻辑：

• 遍历Tbl_spl2elements的第2列，当单元格值等于Combo_spl1load的选中值时，收集对应行第1列的所有匹配值
• 遍历另一关联表格（假设表格名为Tbl_associated，位于同一PL2_steel工作表）的第1列，找到与收集值匹配的行，将对应第2列的值修改为"not defined"

修改后的完整代码 #

Private Sub but_spl1update_Click()

    Dim sh2 As Worksheet
    Set sh2 = ThisWorkbook.Sheets("PL2_steel")
    
    Dim tbl2 As ListObject
    Set tbl2 = sh2.ListObjects("Tbl_spl2elements")
    
    ' 定义关联表格对象，请根据实际表格名修改
    Dim tblAssociated As ListObject
    Set tblAssociated = sh2.ListObjects("Tbl_associated")

    Dim x2 As Long, y As Long, z As Long
    x2 = FirstEmptyColumnRow(tbl2, 1)
    ' 临时变量存储需要匹配的第1列值
    Dim matchValue As String
 
     For y = 1 To x2
            If tbl2.DataBodyRange(y, 2).Value = Combo_spl1load.Value Then
                ' 更新原表格数据
                tbl2.DataBodyRange(y, 3).Value = Txt_spl1totalgwp2.Value
                tbl2.DataBodyRange(y, 5).Value = Val(tbl2.DataBodyRange(y, 4).Value) * Val(Txt_spl1totalgwp2.Value)
                
                ' 获取当前行第1列的匹配值
                matchValue = tbl2.DataBodyRange(y, 1).Value
                
                ' 遍历关联表格，找到匹配项并更新第2列
                For z = 1 To tblAssociated.DataBodyRange.Rows.Count
                    If tblAssociated.DataBodyRange(z, 1).Value = matchValue Then
                        tblAssociated.DataBodyRange(z, 2).Value = "not defined"
                        ' 如果每个匹配值只对应一行，可添加Exit For提升效率
                        ' Exit For
                    End If
                Next z
            End If
     Next y
     

 End Sub

代码说明 #

1. 新增了关联表格tblAssociated的定义，需根据实际表格名称修改变量赋值中的表格名
2. 在原更新逻辑内，新增收集Tbl_spl2elements第1列匹配值的步骤
3. 嵌套循环遍历关联表格，找到匹配行后将第2列值修改为"not defined"
4. 若关联表格中每个匹配值仅对应一行，可取消注释Exit For语句减少循环次数，提升运行效率

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