Excel VBA多表数值按比例调整：指定客户匹配优化需求

需求说明 #

• 通用调整：Sheet1的C1单元格控制Sheet2（Monthly_Budget）的W列、AH列数值按对应百分比增长；D1单元格控制AJ列数值按对应百分比增长。
• 特定客户调整：Sheet1的C2单元格（对应客户ABC）控制Sheet2中该客户行的W列、AH列数值按百分比增长；D2单元格控制该客户行的AJ列数值按百分比增长。

当前问题 #

现有代码已实现C2、D2的批量调整，但无法根据Sheet2的A列客户名称匹配筛选，仅调整指定客户的对应数值，需优化筛选逻辑。

现有代码 #

Private Sub IncreaseRange(ByVal oMultiplier As Double, ByRef oTarget As Range)
    Dim oValue As Variant
    For Each oValue In oTarget
        oValue.Value = oValue.Value * (1 + oMultiplier)
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
      
    Dim LastRow As Long
    Select Case Target.Address
        Case "$C$2"
            Call IncreaseRange(Target.Value, Sheets("Monthly_Budget").Range("W2:AH" & LastRow))
        Case "$D$2"
            Call IncreaseRange(Target.Value, Sheets("Monthly_Budget").Range("AJ2:AJ" & LastRow))
       
    End Select
        
End Sub

优化后代码 #

' 批量按百分比增长指定区域数值
Private Sub IncreaseRange(ByVal oMultiplier As Double, ByRef oTarget As Range)
    Dim oCell As Range
    ' 避免空值或非数值单元格报错
    For Each oCell In oTarget
        If IsNumeric(oCell.Value) Then
            oCell.Value = oCell.Value * (1 + oMultiplier)
        End If
    Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsBudget As Worksheet
    Dim LastRow As Long
    Dim CustomerName As String
    Dim MatchRow As Long
    
    ' 关闭事件触发，防止循环调用
    Application.EnableEvents = False
    
    Set wsBudget = ThisWorkbook.Sheets("Monthly_Budget")
    LastRow = wsBudget.Cells(wsBudget.Rows.Count, "A").End(xlUp).Row ' 正确获取A列最后一行
    
    Select Case Target.Address
        ' 通用调整：C1控制W、AH列
        Case "$C$1"
            IncreaseRange Target.Value, wsBudget.Range("W2:W" & LastRow)
            IncreaseRange Target.Value, wsBudget.Range("AH2:AH" & LastRow)
        ' 通用调整：D1控制AJ列
        Case "$D$1"
            IncreaseRange Target.Value, wsBudget.Range("AJ2:AJ" & LastRow)
        ' 特定客户调整：C2控制该客户的W、AH列
        Case "$C$2"
            CustomerName = "ABC" ' 指定目标客户名称
            ' 查找客户在A列的行号
            On Error Resume Next
            MatchRow = wsBudget.Range("A:A").Find(What:=CustomerName, LookIn:=xlValues, LookAt:=xlWhole).Row
            On Error GoTo 0
            
            If MatchRow > 0 Then ' 找到匹配客户
                IncreaseRange Target.Value, wsBudget.Range("W" & MatchRow & ":AH" & MatchRow)
            End If
        ' 特定客户调整：D2控制该客户的AJ列
        Case "$D$2"
            CustomerName = "ABC" ' 指定目标客户名称
            On Error Resume Next
            MatchRow = wsBudget.Range("A:A").Find(What:=CustomerName, LookIn:=xlValues, LookAt:=xlWhole).Row
            On Error GoTo 0
            
            If MatchRow > 0 Then ' 找到匹配客户
                IncreaseRange Target.Value, wsBudget.Range("AJ" & MatchRow)
            End If
    End Select
    
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

关键优化说明 #

1. 正确获取最后一行：通过wsBudget.Cells(wsBudget.Rows.Count, "A").End(xlUp).Row准确获取Monthly_Budget表中A列的最后数据行，修复原代码中LastRow未赋值的错误。
2. 客户匹配逻辑：使用Range.Find方法在A列精准匹配客户名称（xlWhole确保完全匹配），找到对应行号后仅调整该行的目标列，实现指定客户的单独调整。
3. 事件防循环：添加Application.EnableEvents = False/True，避免单元格值修改后再次触发Worksheet_Change事件导致循环执行。
4. 数值校验：在IncreaseRange中增加IsNumeric判断，防止非数值单元格执行运算时报错。
5. 完善通用调整逻辑：补充了C1、D1对应的全列调整功能，完整覆盖所有需求场景。

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