评估公式参考,但保留公式结构
Evaluate formula references, but keep formula structure
是否可以在 Excel 中评估公式中的引用但保持公式结构?例如如果 A1 = 5 且 B1 = 10
=(A1+B1)/B1
会变成
=(5+10)/10
在单元格中,但保留所有公式结构(即 = + /),而不是计算为 1.5。
我有一些几乎 可用的代码,您可以试用。只要单个单元格在公式中,它就会起作用 - 所以它不会与 A1:C1
一起使用,但会与 A1,B1,C1
一起使用 - 所以没有 VLOOKUPS 或 MATCH。只是简单的公式。
代码的主要部分归功于 Bill Manville。
有一个 Whosebug link:Address of first layer of precedent cells via VBA in Excel 和
原始代码的几个 links:
http://www.vbaexpress.com/forum/showthread.php?19348-Solved-Splitting-all-addresses-in-a-formula&p=142863#post142863
http://www.ozgrid.com/forum/showthread.php?t=17028
代码会将带有值的公式放在单元格的注释中:
Public Sub ReplaceWithValues()
' From original code written by Bill Manville for FindPrecedents.
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim bNewArrow As Boolean
Dim sTmpFormula As String
ActiveCell.ShowPrecedents
Set rLast = ActiveCell
iArrowNum = 1
iLinkNum = 1
bNewArrow = True
'Get an absolute reference version of the formula.
sTmpFormula = Application.ConvertFormula _
(Formula:=ActiveCell.Formula, _
fromReferenceStyle:=xlA1, _
toReferenceStyle:=xlA1, _
toAbsolute:=xlAbsolute)
Do
Do
Application.Goto rLast
On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
On Error GoTo 0
If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
bNewArrow = False
If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
'Formula precedent is in same workbook.
If rLast.Worksheet.Name = ActiveCell.Parent.Name Then
'Formula precedent is on the same sheet as formula.
sTmpFormula = Replace(sTmpFormula, Selection.Address(external:=True), Selection.Value)
sTmpFormula = Replace(sTmpFormula, Selection.Address, Selection.Value)
Else
'Formula precedent is in same workbook, but different sheet.
If InStr(Selection.Parent.Name, " ") > 0 Then
'If the sheet name contains a space the reference will have ' at either end.
sTmpFormula = Replace(sTmpFormula, "'[" & Selection.Parent.Parent.Name & "]" & _
Selection.Parent.Name & "'!" & Selection.Address, Selection.Value)
Else
sTmpFormula = Replace(sTmpFormula, "[" & Selection.Parent.Parent.Name & "]" & _
Selection.Parent.Name & "!" & Selection.Address, Selection.Value)
End If
End If
Else
sTmpFormula = Replace(sTmpFormula, Selection.Address(external:=True), Evaluate(Selection.Address(external:=True)))
End If
iLinkNum = iLinkNum + 1 ' try another link
Loop
If bNewArrow Then Exit Do
iLinkNum = 1
bNewArrow = True
iArrowNum = iArrowNum + 1 'try another arrow
Loop
rLast.Parent.ClearArrows
Application.Goto rLast
rLast.AddComment
rLast.Comment.Text Text:=sTmpFormula
Application.ScreenUpdating = True
End Sub
是否可以在 Excel 中评估公式中的引用但保持公式结构?例如如果 A1 = 5 且 B1 = 10
=(A1+B1)/B1
会变成
=(5+10)/10
在单元格中,但保留所有公式结构(即 = + /),而不是计算为 1.5。
我有一些几乎 可用的代码,您可以试用。只要单个单元格在公式中,它就会起作用 - 所以它不会与 A1:C1
一起使用,但会与 A1,B1,C1
一起使用 - 所以没有 VLOOKUPS 或 MATCH。只是简单的公式。
代码的主要部分归功于 Bill Manville。
有一个 Whosebug link:Address of first layer of precedent cells via VBA in Excel 和
原始代码的几个 links:
http://www.vbaexpress.com/forum/showthread.php?19348-Solved-Splitting-all-addresses-in-a-formula&p=142863#post142863
http://www.ozgrid.com/forum/showthread.php?t=17028
代码会将带有值的公式放在单元格的注释中:
Public Sub ReplaceWithValues()
' From original code written by Bill Manville for FindPrecedents.
Dim rLast As Range, iLinkNum As Integer, iArrowNum As Integer
Dim bNewArrow As Boolean
Dim sTmpFormula As String
ActiveCell.ShowPrecedents
Set rLast = ActiveCell
iArrowNum = 1
iLinkNum = 1
bNewArrow = True
'Get an absolute reference version of the formula.
sTmpFormula = Application.ConvertFormula _
(Formula:=ActiveCell.Formula, _
fromReferenceStyle:=xlA1, _
toReferenceStyle:=xlA1, _
toAbsolute:=xlAbsolute)
Do
Do
Application.Goto rLast
On Error Resume Next
ActiveCell.NavigateArrow TowardPrecedent:=True, ArrowNumber:=iArrowNum, LinkNumber:=iLinkNum
On Error GoTo 0
If rLast.Address(external:=True) = ActiveCell.Address(external:=True) Then Exit Do
bNewArrow = False
If rLast.Worksheet.Parent.Name = ActiveCell.Worksheet.Parent.Name Then
'Formula precedent is in same workbook.
If rLast.Worksheet.Name = ActiveCell.Parent.Name Then
'Formula precedent is on the same sheet as formula.
sTmpFormula = Replace(sTmpFormula, Selection.Address(external:=True), Selection.Value)
sTmpFormula = Replace(sTmpFormula, Selection.Address, Selection.Value)
Else
'Formula precedent is in same workbook, but different sheet.
If InStr(Selection.Parent.Name, " ") > 0 Then
'If the sheet name contains a space the reference will have ' at either end.
sTmpFormula = Replace(sTmpFormula, "'[" & Selection.Parent.Parent.Name & "]" & _
Selection.Parent.Name & "'!" & Selection.Address, Selection.Value)
Else
sTmpFormula = Replace(sTmpFormula, "[" & Selection.Parent.Parent.Name & "]" & _
Selection.Parent.Name & "!" & Selection.Address, Selection.Value)
End If
End If
Else
sTmpFormula = Replace(sTmpFormula, Selection.Address(external:=True), Evaluate(Selection.Address(external:=True)))
End If
iLinkNum = iLinkNum + 1 ' try another link
Loop
If bNewArrow Then Exit Do
iLinkNum = 1
bNewArrow = True
iArrowNum = iArrowNum + 1 'try another arrow
Loop
rLast.Parent.ClearArrows
Application.Goto rLast
rLast.AddComment
rLast.Comment.Text Text:=sTmpFormula
Application.ScreenUpdating = True
End Sub