我有一个这样的公式：
=IF(OR($A1="xyz",$B1="abc",$C5="dmz"),1,0)
我想将每个单元格地址替换为一个明确声明工作表的静态地址，即
=IF(OR(Sheet1!$A$1="xyz",Sheet1!$B$1="abc",Sheet1!$C$5="dmz"),1,0)
我有这个：
Public Function absoluteFormula(sheetname As String, ByVal formula As String) As String
Dim re As New RegExp
Dim matches As MatchCollection
Dim mtch As Match
Dim absoluteAddress As String
'get all addresses in formula
re.pattern = "[$][A-Za-z]+[0-9]+"
re.Global = True
Set matches = re.Execute(formula)
'replace each address with its static version
For Each mtch In matches
absoluteAddress = sheetname & "!" & getAbsoluteAddress(re, mtch.value)
formula = Replace(formula, mtch.value, absoluteAddress)
Next
absoluteFormula = formula
End Function
'makes row static, e.g. "$AU1" -> "$AU$1"
Private Function getAbsoluteAddress(re As RegExp, address As String)
Dim matches As MatchCollection
Dim alphaColumn As String
re.pattern = "[A-Za-z]+"
Set matches = re.Execute(address)
alphaColumn = matches(0).value
getAbsoluteAddress = Replace(address, alphaColumn, alphaColumn & "$")
End Function
这似乎是完成基本功能（伪代码）的许多代码：
find all instances of "[$][alpha]+"
replace with sheetname & "!" & instance & "$"
有没有更简单的方法来执行此替换？
没有经过完全测试，但是这样会有所帮助吗？选择具有公式的单个单元格并运行Sample。我没有做任何错误处理。我假设ActiveCell WILL有一个公式。我也同意您在上述评论中所说的，您的公式将没有命名范围
Dim sformula As String
Dim sh As String
Sub Sample()
Dim cell As Range, c As Range
'~~> This is what you want to append
sh = "Sheet1!"
'~~> Store the formula in a variable
sformula = ActiveCell.Formula
Debug.Print sformula
'~~> Get the precedents
Set cell = ActiveCell.Precedents
'~~> Loop though them
For Each c In cell
ReplaceAddress c.Address '~~> $A$1
ReplaceAddress c.Address(RowAbsolute:=False) '~~> $A1
ReplaceAddress c.Address(ColumnAbsolute:=False) '~~> A$1
ReplaceAddress c.Address(RowAbsolute:=False, ColumnAbsolute:=False) '~~> A1
Next
Debug.Print sformula
End Sub
Function ReplaceAddress(s As String) As String
Dim pos As Long
pos = InStr(1, sformula, s)
Do While pos > 0
If pos = 1 Then
sformula = sh & sformula
ElseIf pos > 1 Then
'~~> Various checks for "!","$" and ":"
If Mid(sformula, pos - 1, 1) <> "!" And Mid(sformula, pos - 1, 1) <> "$" And _
Mid(sformula, pos - 1, 1) <> ":" And Mid(sformula, pos - 2, 1) <> ":" Then
sformula = Left(sformula, pos - 1) & sh & Mid(sformula, pos)
End If
End If
'~~> Find next occurance
pos = InStr(pos + 1, sformula, s)
Loop
ReplaceAddress = sformula
End Function
各种测试
之前：
=IF(OR($A1="xyz",$B1="abc",$C5="dmz"),1,0)
后：
=IF(OR(Sheet1!$A1="xyz",Sheet1!$B1="abc",Sheet1!$C5="dmz"),1,0)
之前：
=VLOOKUP(K4,N10:Q18,1,0)
后：
=VLOOKUP(Sheet1!K4,Sheet1!N10:Q18,1,0)
稍微复杂一点的测试
之前：
=IF(G4>MAX($D$4:$D$8),"N/A",INDEX($B$4:$B$8,INDEX(MATCH(G4,$C$4:$C$8,1),0,0),0))
后：
=IF(Sheet1!G4>MAX(Sheet1!$D$4:$D$8),"N/A",INDEX(Sheet1!$B$4:$B$8,INDEX(MATCH(Sheet1!G4,Sheet1!$C$4:$C$8,1),0,0),0))
评论的跟进
用这个
Sub Sample()
Dim cell As Range, c As Range
'~~> This is what you want to append
sh = "Sheet1!"
'~~> Store the formula in a variable
sformula = ActiveCell.Formula
Debug.Print sformula
'~~> Get the precedents
Set cell = ActiveCell.Precedents
'~~> Loop though them
For Each c In cell
ReplaceAddress c.Address '~~> $A$1
ReplaceAddress c.Address(RowAbsolute:=False) '~~> $A1
ReplaceAddress c.Address(ColumnAbsolute:=False) '~~> A$1
ReplaceAddress c.Address(RowAbsolute:=False, ColumnAbsolute:=False) '~~> A1
sformula = Replace(sformula, c.Address(RowAbsolute:=False), c.Address)
sformula = Replace(sformula, c.Address(ColumnAbsolute:=False), c.Address)
sformula = Replace(sformula, c.Address(RowAbsolute:=False, ColumnAbsolute:=False), c.Address)
Next
Do While InStr(1, sformula, "$$")
sformula = Replace(sformula, "$$", "$")
Loop
Debug.Print sformula
End Sub
Function ReplaceAddress(s As String) As String
Dim pos As Long
pos = InStr(1, sformula, s)
Do While pos > 0
If pos = 1 Then
sformula = sh & sformula
ElseIf pos > 1 Then
'~~> Various checks for "!","$" and ":"
On Error Resume Next
If Mid(sformula, pos - 1, 1) <> "!" And Mid(sformula, pos - 1, 1) <> "$" And _
Mid(sformula, pos - 1, 1) <> ":" And Mid(sformula, pos - 2, 1) <> ":" Then
sformula = Left(sformula, pos - 1) & sh & Mid(sformula, pos)
End If
On Error GoTo 0
End If
'~~> Find next occurance
pos = InStr(pos + 1, sformula, s)
Loop
ReplaceAddress = sformula
End Function
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句