Переместите один столбец влево внутри формулы, используя Excel VBA - PullRequest
0 голосов
/ 07 декабря 2018

У меня есть несколько ячеек, которые содержат следующие формулы (их гораздо больше, но я просто показываю одну в качестве примера, все они следуют одной и той же схеме использования базовых операций, таких как + или - со значениями внутри определенных ячеек)

=+$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 ранее указанных чисел

Обновление 2

Я обнаружил следующее свойство с именем Precedents, которое возвращает диапазон ссылок, по крайней мере, это то, что происходит, если я применяю его ксформулированная ссылка, т. е. в первом примере прецеденты будут возвращать $ O $ 11: $ M $ 11

Обновление 3

Существует еще два типа формул, помимо указанных выше, первый - формулы сa Сумма, т.е.

=Sum($R20:$AC20)

И с IF, например,

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

Все ссылки на ячейки внутри этой формулы должны быть сдвинуты влево на 1.

Ответы [ 2 ]

0 голосов
/ 08 декабря 2018

вы можете использовать вспомогательный временный лист для копирования / вставки данных / формулы, удалить первый столбец (и сдвинуть формулу на один столбец влево) и вставить обратно:

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
0 голосов
/ 08 декабря 2018

Пока вы перезаписываете одну и ту же ячейку, вы можете попробовать:

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 следует большое число, оно может быть принято.Этот тест можно добавить, если это может быть проблемой.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...