假设我在单元格中有一个公式,并且想编辑该公式,我将如何处理?
我正在寻找的示例是我想在公式中的某些点添加$符号,是否有办法告诉VBA在公式中的某些字符之后添加$呢?
我不是在寻找一种将公式转换为绝对引用公式的方法,我只是想知道如何在公式中的某些点添加字符或符号
公式的示例:这是VBA粘贴到单元格中的内容
=IF(A13="Please add a title",0,B17*VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE))
编辑后,我希望它看起来像这样
=IF($A$13="Please add a title",0,B17*VLOOKUP($A$13,'Tables (H)'!$H$2:$J$6,2,FALSE))
[这是与找到职位略有不同的方法。例如,如果公式在名为Cell
的单单元格范围内,则可以使用Replace
:
Cell.Formula = Replace(Cell.Formula, "A13", "$A$13")
编辑:
[好,这是在公式中使用表/ ListObject的第一个单元格的东西。那可能是您想要的更直接的方式。如果没有,我想您可以更改它以使用命名范围的第一个单元格:
Sub test()
Dim ws As Excel.Worksheet
Dim lo As Excel.ListObject
Dim FirstTableCell As Excel.Range
Dim CellWithFormula As Excel.Range
Set ws = ActiveSheet
Set lo = ws.ListObjects(1)
Set FirstTableCell = lo.DataBodyRange.Cells(1)
Set CellWithFormula = ws.Range("A2")
CellWithFormula.Formula = "=" & FirstTableCell.Address & "+1000"
End Sub
[我到处寻找用于修改公式范围的预制解决方案,因此我可以将工作表导入到新的工作簿中,并将页面合并为一张表。
设法制作出效果很好的产品,希望对您有所帮助。
Sub Offset_Ranges_From_Formula(rng As Range, RowOffset As Integer, ColumnOffset As Integer)
Dim arr() As String, arr1() As String, arr2() As String, arr3() As String, cellValue As String, NewCellValue As String
ReDim arr(0): ReDim arr1(0)
For Each rCell In rng
cellValue = rCell.Formula
For s = 2 To Len(cellValue)
Debug.Print Mid(cellValue, s, 1)
If s < Len(cellValue) Then
If Is_Range(Mid(cellValue, s, 4)) Then
If arr(UBound(arr)) <> "" Then ReDim Preserve arr(UBound(arr) + 1): If arr1(UBound(arr1)) <> "" Then ReDim Preserve arr1(UBound(arr1) + 1)
arr(UBound(arr)) = Mid(cellValue, s, 4)
If InStr("", "$") = 1 And InStr(2, "", "$") = 3 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(True, True)
Else
If InStr("", "$") = 1 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(True, False)
Else
If InStr("", "$") = 2 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(False, True)
Else
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(False, False)
End If
End If
End If
Else
If Is_Range(Mid(cellValue, s, 3)) Then
If arr(UBound(arr)) <> "" Then ReDim Preserve arr(UBound(arr) + 1): If arr1(UBound(arr1)) <> "" Then ReDim Preserve arr1(UBound(arr1) + 1)
arr(UBound(arr)) = Mid(cellValue, s, 3)
If InStr("", "$") = 0 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 3)).Offset(RowOffset, ColumnOffset).Address(False, False)
Else
If InStr("", "$") = 1 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 3)).Offset(RowOffset, ColumnOffset).Address(True, False)
Else
If InStr("", "$") = 2 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 3)).Offset(RowOffset, ColumnOffset).Address(False, True)
End If
End If
End If
Else
If Is_Range(Mid(cellValue, s, 2)) Then
If arr(UBound(arr)) <> "" Then ReDim Preserve arr(UBound(arr) + 1): If arr1(UBound(arr1)) <> "" Then ReDim Preserve arr1(UBound(arr1) + 1)
arr(UBound(arr)) = Mid(cellValue, s, 2)
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 2)).Offset(RowOffset, ColumnOffset).Address(False, False)
End If
End If
End If
End If
Next
For i = LBound(arr) To UBound(arr)
cellValue = Replace(cellValue, arr(i), "[SPLIT_FORMULA]")
Next
arr2 = Split(cellValue, "[SPLIT_FORMULA]")
ReDim arr3(UBound(arr1) + UBound(arr2) + 2)
Odd = 0
Even = 0
For i = 1 To UBound(arr3) + 2
If Application.IsEven(i) Then
If UBound(arr1) >= Even Then
arr3(i - 1) = arr1(Even)
Even = Even + 1
End If
Else
If UBound(arr2) >= Odd Then
arr3(i - 1) = arr2(Odd)
Odd = Odd + 1
End If
End If
Next
NewCellValue = Join(arr3, "")
rCell.Formula = NewCellValue
Next rCell
End Sub