有没有办法在vba中编辑公式

Question

假设我在单元格中有一个公式，并且我想编辑该公式，我该怎么做？

我正在寻找的示例是我想在公式中的某些点添加 $ 符号，有没有办法告诉 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))

Answer 1

这是一种与查找位置略有不同的方法。例如，如果公式位于名为 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

Answer 2

我到处寻找一个预制的解决方案来修改公式中的范围，这样我就可以将工作表导入新的工作簿并将页面合并到一个工作表中。

设法制作了一些效果很好的东西希望它可以帮助你。

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