Question

我有一些包含以下公式的单元格（还有很多，但我仅以一个示例为例，它们都遵循使用+或-之类的基本运算的相同模式，并且某些单元格内包含值）

=+$O11+$N11+$M11

我需要将每一列向左移动，以得到类似

的结果

=+$N11+$M11+$L11

问题是我已经写了一些代码来检测一个单元格是否有一个公式或只有一个值

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

但是我仍在寻找如何将所有列引用向左移动的方法，我编写的唯一尝试这样做的代码不起作用

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

更新1

有些公式仅使用1个单元格来检查是否设置了该单元格，最多使用8个引用的单元格。数字或参考文献围绕这两个先前陈述的数字

更新2

我发现以下名为Precedents的属性正在返回引用范围，至少这是将其应用于公式化引用的过程，即在第一个示例中，先例将返回$ O $ 11：$ M $ 11

更新3

除上述公式外，还有另外两种类型的公式，第一种是具有总和的公式，即

=Sum($R20:$AC20)

并带有IF，即

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

此公式中的所有单元格引用都必须向左移动1。

Answer 1

只要您覆盖同一单元格，就可以尝试：

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

我使用正则表达式查找列名，形式为Cnn或C[nn]或C[-nn] 然后，我们可以从nn中减去一个来获得新的列号使用位置和长度确定替换物的放置位置。

如果结果公式引用到列A左侧的一列，则此宏将以运行时错误1004终止。您可能应该根据在该实例中要执行的操作添加一个例程。

编辑： 我没有进行测试以确保Cnn是有效的单元格地址，而不是NAME。通常，除非您有一些非常不寻常的名称（例如Cnnnnnnnnn），否则将不重要，因为与单元地址冲突的名称将被拒绝，但是如果您的C后跟大量数字，则可能是公认。如果可能有问题，可以添加该测试。

Answer 2

您可以使用辅助临时表将数据/公式复制/粘贴到其中，删除第一列（并使公式向左移动一列）并粘贴回去：

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

或者您可以使用公式对每个单元格进行操作：

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

使用Excel的vba

更新1

更新2

更新3

2 个答案: