Вставка формулы из массива в VBA в таблицу Excel - PullRequest
0 голосов
/ 23 апреля 2020

Поэтому я пытаюсь сделать сценарии VBA, которые изменяют все косвенные формулы в выборе, на прямую ссылку, целью является повышение производительности моей книги Excel. Ниже приведен код:

Call manual
Dim continue As Integer
continue = MsgBox("This cannot be undone.  Continue anyway?", vbOKCancel)
If continue <> vbOK Then Exit Sub

Dim formula_array() As Variant

row_cnt = Selection.Rows.count
col_cnt = Selection.Columns.count

ReDim formula_array(1 To row_cnt, 1 To col_cnt)

If row_cnt = 1 And col_cnt = 1 Then
    formula_array(1, 1) = Selection.formula
Else
    formula_array = Selection.formula
End If
'for some reason formula_array = Selection.formula gives an error when I select only one cell
count = 0
Dim i As Integer, y As Integer
For i = 1 To row_cnt
    For y = 1 To col_cnt
        frmula = formula_array(i, y)
        oldfunc = find_full_formula(frmula, "indirect(")
        Do While (oldfunc <> "")
            newfunc = Application.Evaluate(oldfunc)
            If IsError(newfunc) Then
                newfunc = ""
            End If
            oldfunc = "indirect(" & oldfunc & ")"
            formula_array(i, y) = Replace(formula_array(i, y), oldfunc, newfunc, 1, -1, vbTextCompare)
            frmula = formula_array(i, y)
            oldfunc = find_full_formula(frmula, "indirect(")
            count = count + 1
        Loop
    Next y
Next i
Dim temp As String
Selection.formula = formula_array
MsgBox count
Call auto

Здесь функция find_full_formula предоставляет аргументы любой функции, input - это начало этой функции и всей формулы. Так что если у вас есть формула «Косвенный (« A1: B2 »)», то результатом этой функции будет «A1: B2».

Весь сценарий работает очень хорошо для нормальных диапазонов, кроме случаев, когда я пытаюсь запустите столбец таблицы Excel, где выбор также включает первую ячейку столбца (первую ячейку данных, а не заголовок), и в результате все ячейки в этом столбце имеют такую ​​же формулу, что и первая ячейка. Также интересно то, что если я выберу все ячейки столбца таблицы, кроме первой, то результат будет хорошим, но только если первая ячейка также задействована, возникает проблема. Очевидно, это выглядит как функция автозаполнения, но я отключил все такие настройки, которые смог найти, и все же эта проблема не решена.

хорошо, я добавляю ниже гораздо более простую версию кода VBA в выделите мою проблему:

Dim arr(1 To 4, 1 To 1) As Variant
arr(1, 1) = "2+2"
arr(2, 1) = "=3+2"
arr(3, 1) = "=4+2"
arr(4, 1) = "=5+2"
Range("A2:A5").Formula = arr

этот код выше работает просто отлично, однако приведенный ниже код приводит к "= 2 + 2" в качестве формулы для каждой ячейки моей таблицы.

Dim arr(1 To 4, 1 To 1) As Variant
arr(1, 1) = "=2+2"
arr(2, 1) = "=3+2"
arr(3, 1) = "=4+2"
arr(4, 1) = "=5+2"
Range("A2:A5").Formula = arr

Таблица в Excel выглядит примерно так: Таблица Excel

1 Ответ

0 голосов
/ 24 апреля 2020

Я нашел решение, которое работает во всех случаях, которые я проверил, но это не красиво - рассмотрите это как обходной путь:

  1. установите Application.AutoCorrect.AutoFillFormulasInLists = False
  2. установите формулу для ячеек зацикливая их (один за другим)

Ни один из этих одних только не устанавливает формулы, как ожидается, если выбор соответствует ListObject.DataBodyRange.

Sub Test()
    ' select a range that fits
    ' the following arrays dimensions

    Dim arr(1 To 4, 1 To 2) As Variant
    arr(1, 1) = "=2+2": arr(1, 2) = "=12+2"
    arr(2, 1) = "=3+2": arr(2, 2) = "=13+2"
    arr(3, 1) = "=4+2": arr(3, 2) = "=14+2"
    arr(4, 1) = "=5+2": arr(4, 2) = "=15+2"

    ' deactivate AutoFillFormulasInLists; store setting to restore
    Dim bAutoFill As Boolean
    bAutoFill = Application.AutoCorrect.AutoFillFormulasInLists
    Application.AutoCorrect.AutoFillFormulasInLists = False

    Selection.ClearContents

    ' `Selection.FormulaR1C1 = arr` does NOT work in case of
    ' Selection = ListObject.DataBodyRange
    ' => loop cells (slower and more lines of code)

    Dim i As Long, j As Long
    For i = 1 To UBound(arr, 1)
        For j = 1 To UBound(arr, 2)
            Selection(i, j).FormulaR1C1 = arr(i, j)
        Next j
    Next i

    Application.AutoCorrect.AutoFillFormulasInLists = bAutoFill
End Sub

Надеюсь, кто-то еще вставит более простое решение!

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