سؤال

Hypothetically if I had a formula in a cell and I wanted to edit that formula how would I go about it?

The example I am looking for is I want to add $ signs at certain points within the formula, is there a way to tell VBA to add $'s after certain characters within a formula?

I am not looking for a method to turn the formula into an absolute reference formula, I just want to know how to add characters or symbols at certain points within the formula

The formula's example: This is what is pasted into the cell by VBA

=IF(A13="Please add a title",0,B17*VLOOKUP(A13,'Tables (H)'!$H$2:$J$6,2,FALSE))

After editing I want it to look like this

=IF($A$13="Please add a title",0,B17*VLOOKUP($A$13,'Tables (H)'!$H$2:$J$6,2,FALSE))
هل كانت مفيدة؟

المحلول

This is a slightly different approach than finding the position. If, for example, the formula is in a single-cell range called Cell you can use Replace:

Cell.Formula = Replace(Cell.Formula, "A13", "$A$13")

EDIT:

Okay, here's something that uses the first cell of a table/ListObject in a formula. That may be a more direct way to what you want. If not, I think you can alter it to use the first cell of a named range:

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

نصائح أخرى

I looked all over to find a pre-made solution to modify ranges in formulas so I could import worksheets into a new work book and combining the pages into one sheet.

managed to make something that works well hope it helps you.

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
مرخصة بموجب: CC-BY-SA مع الإسناد
لا تنتمي إلى StackOverflow
scroll top