Question

假设我在单元格中有一个公式并且我想编辑该公式我将如何处理它？</ p>

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

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

2 个答案: