使用 Excel 的 vba 在公式中向左移动一列

Question

I have some cells that contain the following formulas (there are a lot more but I'm just showing one as an example, they all follow the same pattern of using basic operations like + or - with the values inside certain cells)

=+$O11+$N11+$M11

and I need to move every column one to the left as to end up with something like

=+$N11+$M11+$L11

the thing is that I have already written code that detects whether or not a cell has a formula or only a value

for each cell in Selection // im using a selection for testing purposes only
   if cell.hasFormula() = true then
   end if
next cell

but I'm still figuring out how to shift all the column references one to the left, the only code I have written trying to do that does not work

auxiliary = "=offset(" + Replace(cell.formula, "=","") + ",0,1)"
cell.formula = auxiliary

Update 1

There are formulas that only use 1 cell to check either if its set or not, up to 8 referenced cells. Numbers or references move around those 2 previously stated numbers

Update 2

I found the following property named Precedents that is returning the range of references, at least that's what doing if I apply it to a formulated reference ie with the first example, precedents would return $O$11:$M$11

Update 3

There are two more types of formulas besides the one stated above, the first is formulas with a Sum ie

=Sum($R20:$AC20)

And with IFs ie

=IF($BG20=0,1," ")

All of the cell references inside of this formulas must be shifted to the Left by 1.

Answer 1

So long as you are overwriting the same cell, you can try:

Option Explicit
Sub shiftLeft()
    Dim f As String
    Dim origCol As Long, newCol As Long
    Dim r As Range, c As Range
    Dim re As Object, mc As Object, m As Object
    Dim I As Long, startNum As Long, numChars As Long

Set re = CreateObject("vbscript.regexp")
With re
    .Global = True
    .Pattern = "C\[?(-?\d+)"
End With

Set r = Range(Cells(1, 9), Cells(Rows.Count, 9).End(xlUp))
For Each c In r
    If c.HasFormula = True Then
        f = c.FormulaR1C1
        'Debug.Print f, c.Formula
        If re.test(f) = True Then
            Set mc = re.Execute(f)
            For I = mc.Count To 1 Step -1
                Set m = mc(I - 1)
                startNum = m.firstindex + 1 + Len(m) - Len(m.submatches(0))
                numChars = Len(m.submatches(0))
                newCol = m.submatches(0) - 1
                f = WorksheetFunction.Replace(f, startNum, numChars, newCol)
            Next I
        End If
    End If
    c.FormulaR1C1 = f
    'Debug.Print f, c.Formula & vbLf
Next c

End Sub

I use regular expressions to find the column designation which will be in the form of Cnn or C[nn] or C[-nn] We can then subtract one from nn to get the new column number Use the location and length to decide where to place the replacement.

If the resultant formula refers to a column to the left of column A , this macro will terminate with a run-time error 1004 . You should probably add a routine depending on what you want to do in that instance.

EDIT: I did not test to ensure that Cnn is a valid cell address and not a NAME . Mostly that won't matter unless you have some very unusual names (eg Cnnnnnnnnn ) since names that conflict with cell addresses will be rejected, but if your C is followed by a large number, it may be accepted. That test could be added if it might be an issue.

Answer 2

you could use a helper temporary sheet to copy/paste data/formula to, delete first column (and have formula shift one column left) and paste back:

Dim tmpSht As Worksheet
Dim rng As Range

Set rng = Selection
Set tmpSht = Worksheets.Add
With rng
    .Copy Destination:=tmpSht.Range(rng.Address).Offset(, -1)
End With

With tmpSht
    .Columns(1).Delete
    .Range(rng.Address).Offset(, -2).Copy Destination:=rng
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End With

---

or you could act on every single cell with formula:

Sub main()
    Dim tmpSht As Worksheet
    Dim cell As Range, rng As Range

    Set rng = Selection
    Set tmpSht = Worksheets.Add ' add a "helper" temporary worksheet

    For Each cell In rng.SpecialCells(xlCellTypeFormulas) ' loop through selection cells containing a formula
        ShiftFormulaOneColumnToTheLeft cell, tmpSht
    Next

    'delete "helper" worksheet
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End Sub

Sub ShiftFormulaOneColumnToTheLeft(rng As Range, hlpSht As Worksheet)
    rng.Copy Destination:=hlpSht.Range("B1") ' copy passed range and paste it to passed "helper" worksheet range "B1"

    With hlpSht ' reference passed "helper" worksheet
        .Columns(1).Delete ' delete referenced worksheet first column and have all its formulas shift one column to the left
        .Range("A1").Copy Destination:=rng ' copy "helper" worksheet "A1" cell (where previous "B1" has ended to) content  to passed range
    End With
End Sub

Answer 3

This would work to move/shift the formula's references as intended:

strFormula$ = "=+$O11+$N11+$M11"
strFormulaMoved$ = Application.ConvertFormula(Application.ConvertFormula(Selection.Formula, XlReferenceStyle.xlA1, XlReferenceStyle.xlR1C1, XlReferenceType.xlRelative, Selection), XlReferenceStyle.xlR1C1, XlReferenceStyle.xlA1, XlReferenceType.xlRelRowAbsColumn, Selection.Offset(0, -1))