[英]Is there a simple way to replace with placeholders in Excel?
我有一個這樣的公式:
=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
將有一個公式。 我也同意您在上述評論中所說的,您的公式將沒有命名范圍
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
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.