Excel 批量修改公式中单元格引用的地址
本帖最后由 xiaofishball 于 2024-6-13 15:41 编辑场景再现
拿到同事发过来的Excel表的时候，发现我每次引用的表结构有调整
比如在上图C下面增加了X，Y，Z
导致我复制之前保存的模板公式引用对应行时数据出现错位
如果是自己修改前表的话不会有这个问题，插入了新行Excel会自动修改引用
但是我这种复制公式过来的话就得自己想办法调公式了
需要给这些公式里的引用统一增加一个偏移量，替换的话只能一行一行修改，数据多的情况下就太费劲了
整了一个比较简单的脚本，分享给大家
使用的时候替换前面3个变量为自己表就可以了
refSheetName = "Sheet3"
sheetName = "Sheet1"
target = "B3:I4"
注意
因为我的表里没有太复杂的引用，这里假设所有的公式引用都是直接的（例如Sheet3!A1），并且不包含嵌套引用或更复杂的结构。
代码
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 & "!(+)(\$?)(\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 "Formulasupdated 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 = ""
regex.Global = True ' 设置为 True 以替换所有匹配项
' 执行替换操作，将匹配到的数字替换为空字符串
outputString = regex.Replace(inputString, "")
' 返回处理后的字符串
RemoveNumbersFromString = outputString
' 清理
Set regex = Nothing
End Function 如果从B列往后面数据啥的公式啥的都是一样的情况下，你就根据A列判断并引用对应的数据就是咯，公式啥的不要改来改去的，很容易出错，最好就是跟你同事协商一下，看看怎么添加一个条件啥的然后自动生成对应的内容，然后无论对方怎么调整顺序都不会有影响才是王道，它今天动这里，明天要是动了别的地方，如果那俩数据是一样的一时你没发现异常，然后等数据量大的时候你在发现异常，你再去核对那就工作量大了 $ 符号有没有用？ yimenghan 发表于 2024-6-13 15:58
如果从B列往后面数据啥的公式啥的都是一样的情况下，你就根据A列判断并引用对应的数据就是咯，公式啥的不 ...
害，协商才是最费劲的，人家不愿意动，只能自己想办法了{:301_999:} 你只有解决了上游的问题，也就解决了自己的问题 可以试试方方格子的，公式转文本，然后搜索替换就可以了 可以试试方方格子的，公式转文本，然后搜索替换就可以了 进来学习一下 进来学习一下
学习一下新技术
页:
[1]
2