没有完全测试,但这样的帮助?选择具有公式的单个单元格并运行Sample.我没有做任何错误处理.我假设ActiveCell将有一个公式.我也会按照你在上面的评论中说的那样,你的公式将没有命名范围
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,1) <> "$" And _
Mid(sformula,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,s)
Loop
ReplaceAddress = sformula
End Function
各种测试
之前:
=IF(OR($A1="xyz",0)
后:
=IF(OR(Sheet1!$A1="xyz",Sheet1!$B1="abc",Sheet1!$C5="dmz"),0)
之前:
=VLOOKUP(K4,N10:Q18,0)
后:
=VLOOKUP(Sheet1!K4,Sheet1!N10:Q18,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))
后:
=IF(Sheet1!G4>MAX(Sheet1!$D$4:$D$8),INDEX(Sheet1!$B$4:$B$8,INDEX(MATCH(Sheet1!G4,Sheet1!$C$4:$C$8,0))
跟进评论
用这个
Sub Sample()
Dim cell As Range,ColumnAbsolute:=False) '~~> A1
sformula = Replace(sformula,c.Address(RowAbsolute:=False),c.Address)
sformula = Replace(sformula,c.Address(ColumnAbsolute:=False),c.Address(RowAbsolute:=False,ColumnAbsolute:=False),c.Address)
Next
Do While InStr(1,"$$")
sformula = Replace(sformula,"$$","$")
Loop
Debug.Print sformula
End Sub
Function ReplaceAddress(s As String) As String
Dim pos As Long
pos = InStr(1,"$" and ":"
On Error Resume Next
If Mid(sformula,pos)
End If
On Error GoTo 0
End If
'~~> Find next occurance
pos = InStr(pos + 1,s)
Loop
ReplaceAddress = sformula
End Function