Excel 批量修改公式中单元格引用的地址

xiaofishball

场景再现

拿到同事发过来的Excel表的时候，发现我每次引用的表结构有调整

原数据表

比如在上图C下面增加了X，Y，Z

变化的数据表

导致我复制之前保存的模板公式引用对应行时数据出现错位

错误的引用表

如果是自己修改前表的话不会有这个问题，插入了新行Excel会自动修改引用
但是我这种复制公式过来的话就得自己想办法调公式了

引用表公式

需要给这些公式里的引用统一增加一个偏移量，替换的话只能一行一行修改，数据多的情况下就太费劲了
整了一个比较简单的脚本，分享给大家

使用的时候替换前面3个变量为自己表就可以了
refSheetName = "Sheet3"
sheetName = "Sheet1"
target = "B3:I4"

注意
因为我的表里没有太复杂的引用，这里假设所有的公式引用都是直接的（例如Sheet3!A1），并且不包含嵌套引用或更复杂的结构。

代码

[Asm] 纯文本查看 复制代码

Sub IncrementRowNumbersInRange()
    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim formula As String
    Dim newFormula As String
    Dim regex As Object
    Dim match As Object
    Dim matchCollection As Object
    Dim sheetName As String
    Dim refSheetName As String
    Dim target As String
    Dim rowNumStr As String
    Dim rowNum As Integer
    Dim addNum As Integer
    Dim hasDollarSign As Boolean
      
    ' 设置要修改的工作表名称、引用的工作表名称和想要修改公式的范围
    refSheetName = "Sheet3"
    sheetName = "Sheet1"
    target = "B3:I4"
    addNum = 3
    Set ws = ThisWorkbook.Sheets(sheetName)
    Set rng = ThisWorkbook.Sheets(sheetName).Range(target)
      
    ' 创建一个正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
    regex.Global = True ' 搜索整个字符串
    regex.Pattern = refSheetName & "!([A-Z]+)(\$?)(\d+)" ' 匹配类似 "Sheet3!A$4" 或 "Sheet3!A4" 的模式
      
    ' 遍历范围内的每个单元格
    For Each cell In rng
        If cell.HasFormula Then ' 只处理包含公式的单元格
            formula = cell.formula
            newFormula = formula
              
            ' 查找并替换单元格引用中的行号
            Set matchCollection = regex.Execute(formula)
            For Each match In matchCollection
                ' 提取行号字符串，注意 SubMatches 索引从 0 开始
                rowNumStr = IIf(match.SubMatches(1) = "$", "$", "") & match.SubMatches(2) ' 可能是 "$4" 或 "4"
                rowNum = Val(rowNumStr)
                If rowNum > 0 Then
                    rowNum = rowNum + addNum
                    ' 替换行号，注意这里也只是简单的把新的行号拼在了字符串最后
                       newFormula = RemoveNumbersFromString(formula) & rowNum
                End If
            Next match
              
            ' 应用新公式
            cell.formula = newFormula
        End If
    Next cell
      
    MsgBox "Formulas  updated successfully!"
      
    ' 清理
    Set regex = Nothing

End Sub

' 把字符串中的数字删除
Function RemoveNumbersFromString(ByVal inputString As String) As String
    Dim regex As Object
    Dim outputString As String
      
    ' 创建一个正则表达式对象
    Set regex = CreateObject("VBScript.RegExp")
      
    ' 设置模式以匹配任何数字
    regex.Pattern = "[0-9]"
    regex.Global = True ' 设置为 True 以替换所有匹配项
      
    ' 执行替换操作，将匹配到的数字替换为空字符串
    outputString = regex.Replace(inputString, "")
      
    ' 返回处理后的字符串
    RemoveNumbersFromString = outputString
      
    ' 清理
    Set regex = Nothing
End Function

yimenghan

如果从B列往后面数据啥的  公式啥的都是一样的情况下，你就根据A列判断并引用对应的数据就是咯，公式啥的不要改来改去的，很容易出错，最好就是跟你同事协商一下，看看怎么添加一个条件啥的然后自动生成对应的内容，然后无论对方怎么调整顺序都不会有影响才是王道，它今天动这里，明天要是动了别的地方，如果那俩数据是一样的一时你没发现异常，然后等数据量大的时候你在发现异常，你再去核对那就工作量大了

discoverme

$ 符号有没有用？

xiaofishball

yimenghan 发表于 2024-6-13 15:58
如果从B列往后面数据啥的  公式啥的都是一样的情况下，你就根据A列判断并引用对应的数据就是咯，公式啥的不 ...

害，协商才是最费劲的，人家不愿意动，只能自己想办法了

lkl2425572

你只有解决了上游的问题，也就解决了自己的问题

jyjjf

可以试试方方格子的，公式转文本，然后搜索替换就可以了

intlhz

可以试试方方格子的，公式转文本，然后搜索替换就可以了

ok667

进来学习一下

174911

进来学习一下

Lattle_grass

学习一下新技术