修改CTC_Code VBA代码实现全数据范围批量处理

现有CTC_Code宏仅针对C2行执行业务逻辑，需调整为遍历C列所有包含数据的行，根据每行C列数值所在区间执行对应计算、公式设置与复制粘贴操作。

原代码问题分析 #

• 仅固定处理第2行，无法批量处理多行数据
• 大量重复的粘贴操作代码，冗余度高
• 依赖Select/Selection操作，执行效率低且易出错

修改后的代码 #

Sub CTC_Code()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' 指定工作表，避免Activate操作
    Set ws = ThisWorkbook.Sheets("CTC_Calculator_A1")
    ' ws.Unprotect Password:="123321"
    
    ' 获取C列最后一行有数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    ' 遍历所有有数据的行（从第2行开始，假设第1行是表头）
    For i = 2 To lastRow
        With ws.Rows(i)
            ' 根据C列数值区间执行逻辑
            If .Range("C1").Value >= 50000 Then
                .Range("H1").Formula = "=ROUND(G" & i & "*50%,0)"
                ' 执行K列的6次粘贴累加操作
                PasteAddValue .Range("V1"), .Range("K1"), .Range("Z1").Value
            ElseIf .Range("C1").Value >= 27000 And .Range("C1").Value <= 49999 Then
                .Range("H1").Formula = "=ROUND(G" & i & "*50%,0)"
                PasteAddValue .Range("V1"), .Range("K1"), .Range("Z1").Value
            ElseIf .Range("C1").Value <= 26999 Then
                .Range("H1").Formula = "=ROUND(0,0)"
                .Range("K1").Formula = "=ROUND(0,0)"
                PasteAddValue .Range("V1"), .Range("H1"), .Range("Z1").Value
            End If
        End With
    Next i
    
    Application.CutCopyMode = False
    ' ws.Protect Password:="123321"
End Sub

' 封装重复的粘贴累加逻辑，减少代码冗余
Private Sub PasteAddValue(copyRange As Range, pasteRange As Range, zValue As Variant)
    Dim j As Integer
    ' 仅当Z列值不等于1时执行6次粘贴累加
    If zValue <> 1 Then
        copyRange.Copy
        For j = 1 To 6
            pasteRange.PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=False, Transpose:=False
        Next j
    End If
End Sub

关键修改说明 #

• 批量遍历：通过lastRow获取C列最后一行数据，用For循环遍历所有目标行
• 取消Select依赖：直接通过工作表和单元格引用操作，避免激活/选择操作带来的问题
• 代码封装：将重复6次的粘贴累加逻辑封装为子过程PasteAddValue，简化主代码结构
• 逻辑优化：用ElseIf替代多个独立If，避免同一行被多次判断
• 动态公式：公式中使用行号i生成对应单元格引用，适配不同行

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