如何基于选中单元格区域运行宏？保留绝对引用转置数据

核心需求实现代码 #

把原来固定单元格的宏改成基于选中区域的版本，这个宏会读取你选中的任意区域，将区域内所有带绝对引用（含$符号）的公式原样复制到对应行的第一列：

Sub CopyAbsoluteFormulasToFirstColumn()
    Dim targetRange As Range
    Dim rowIdx As Long
    Dim colIdx As Integer
    
    ' 获取用户选中的操作区域
    Set targetRange = Selection
    
    ' 遍历区域内的每一行
    For rowIdx = 1 To targetRange.Rows.Count
        ' 从第2列开始检查每一个单元格
        For colIdx = 2 To targetRange.Columns.Count
            With targetRange.Cells(rowIdx, colIdx)
                ' 判断单元格是否包含带绝对引用的公式
                If .HasFormula And InStr(.Formula, "$") > 0 Then
                    ' 原样复制公式到该行的第一列
                    targetRange.Cells(rowIdx, 1).Formula = .Formula
                End If
            End With
        Next colIdx
    Next rowIdx
End Sub

代码关键修改点 #

• 用Set targetRange = Selection替代原来的固定单元格引用（比如Range("A1:L10")），直接绑定用户选中的区域。
• 通过读取单元格的.Formula属性复制公式，确保绝对引用（$）完全保留，不会因为复制位置变化而被修改。
• 增加双重判断：先检查是否是公式，再检查是否包含绝对引用，避免复制无关内容。

重复执行100次的两种方案 #

方案1：手动快速执行

1. 打开Excel的开发工具选项卡，点击宏，选中CopyAbsoluteFormulasToFirstColumn，点击选项，设置一个快捷键（比如Ctrl+Shift+C）。
2. 每次选中目标区域后，按下快捷键即可执行，重复100次即可。

方案2：自动批量处理100个区域

如果你的100个目标区域是规律排列的（比如每12列为一组，连续分布在工作表中），可以用下面的宏自动遍历处理：

Sub BatchProcess100Regions()
    Dim i As Integer
    Dim startCol As Integer
    Dim totalRows As Long
    Dim regionCols As Integer
    
    regionCols = 12 ' 每组固定12列，可根据实际修改
    totalRows = 100 ' 每组的行数，替换成你的实际行数
    
    For i = 1 To 100
        ' 计算当前组的起始列
        startCol = (i - 1) * regionCols + 1
        ' 定义当前组的区域范围
        Set targetRange = ActiveSheet.Range(Cells(1, startCol), Cells(totalRows, startCol + regionCols - 1))
        ' 调用核心处理逻辑
        CopyAbsoluteFormulasToFirstColumnForBatch targetRange
    Next i
End Sub

' 适配批量处理的核心逻辑（和手动版逻辑一致，只是改成带参数）
Sub CopyAbsoluteFormulasToFirstColumnForBatch(ByVal targetRange As Range)
    Dim rowIdx As Long
    Dim colIdx As Integer
    
    For rowIdx = 1 To targetRange.Rows.Count
        For colIdx = 2 To targetRange.Columns.Count
            With targetRange.Cells(rowIdx, colIdx)
                If .HasFormula And InStr(.Formula, "$") > 0 Then
                    targetRange.Cells(rowIdx, 1).Formula = .Formula
                End If
            End With
        Next colIdx
    Next rowIdx
End Sub

注意事项 #

• 执行宏前建议备份工作表，避免误操作覆盖原有数据。
• 如果你的区域不是固定12列，可删除批量处理中的regionCols = 12相关逻辑，改用手动选中的方式执行。
• 公式中的绝对引用会被完整保留，因为我们直接复制的是公式文本，而非计算结果。

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