如何基于指定列创建VBA循环，优化多列重复执行的代码？

问题核心 #

当前代码需要对30多列执行不同组合的ReturnTheSlab和TheManInGauze子过程，重复代码冗余，后续增减列维护成本高。我们可以通过列-子过程配置列表的方式，用循环统一处理所有列，彻底简化代码结构。

优化方案 #

1. 定义一个二维数组作为配置表，每一行存储：
   • 目标列的标识（如"V:V"、"X:X"）
   • 需要执行的子过程名称数组（如Array("TheManInGauze")或Array("ReturnTheSlab", "TheManInGauze")）
2. 循环遍历配置数组，对每一列获取有效数据范围，依次执行对应的子过程
3. 移除不必要的Select操作，直接引用工作表，提升代码效率和稳定性

完整优化代码 #

Sub YouGoGlenCoCo()
    Dim rngTmp As Range
    Dim colConfig As Variant
    Dim i As Long, j As Long
    Dim ws As Worksheet
    
    ' 设置目标工作表，避免Select操作
    Set ws = ThisWorkbook.Sheets("ALL TYPES")
    
    ' 定义列配置：每一行 = 列标识, 要执行的子过程数组
    ' 可根据需求直接增减/修改这部分配置
    colConfig = Array( _
        Array("V:V", Array("TheManInGauze")), _
        Array("X:X", Array("ReturnTheSlab", "TheManInGauze")), _
        Array("Y:Y", Array("ReturnTheSlab")), _
        Array("Z:Z", Array("ReturnTheSlab", "TheManInGauze")) _
        ' 继续添加更多列的配置...
    )
    
    ' 循环处理每一列配置
    For i = LBound(colConfig) To UBound(colConfig)
        With ws
            ' 获取当前列的有效数据范围
            Set rngTmp = Intersect(.Range(colConfig(i)(0)), .UsedRange)
        End With
        
        ' 执行当前列对应的所有子过程
        If Not rngTmp Is Nothing Then
            For j = LBound(colConfig(i)(1)) To UBound(colConfig(i)(1))
                Select Case colConfig(i)(1)(j)
                    Case "ReturnTheSlab"
                        ReturnTheSlab rngTmp
                    Case "TheManInGauze"
                        TheManInGauze rngTmp
                End Select
            Next j
        End If
    Next i
    
    ' 清理对象
    Set rngTmp = Nothing
    Set ws = Nothing
    MsgBox "Update Complete, please verify"
End Sub

Sub ReturnTheSlab(rngTmp As Range)
    Dim rngCell As Range
    
    For Each rngCell In rngTmp
        rngCell.Replace what:="#", replacement:="" ' 移除#避免错误
        rngCell.Replace what:="$", replacement:="This is a dollar sign"
        rngCell.Replace what:"%", replacement:"This is a percent sign"
        If InStr(1, rngCell.Value, "$") > 0 Then
            rngCell.Value = rngCell.Value & " This is a dollar sign after"
        End If
    Next rngCell
End Sub

Sub TheManInGauze(rngTmp As Range)
    Dim rngCell As Range
    
    For Each rngCell In rngTmp
        If InStr(1, rngCell.Offset(0, 1).Value, "$") > 0 Then
            rngCell.Value = "Adding words " & rngCell.Value
        End If
    Next rngCell
End Sub

使用说明 #

• 增减列/修改子过程组合：直接修改colConfig数组即可，比如要给列"A:A"只执行ReturnTheSlab，就添加一行Array("A:A", Array("ReturnTheSlab"))
• 代码移除了Select操作，直接通过ws变量引用工作表，避免激活工作表带来的潜在问题
• 每次处理前用Intersect获取列的有效数据范围，避免遍历整列空单元格，提升执行效率

内容的提问来源于stack exchange，提问作者Gregg Mireau Jr.