没有完全测试,但这样的帮助？选择具有公式的单个单元格并运行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, 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