數組VBA Excel中的公式

Question

我將數據放入在VBA中創建的數組中。

我在宏中寫了一些公式，但是粘貼它們時不起作用。

Sub Button3_Click()

Application.Calculation = xlManual

'update list of document

'declare variables

Dim i As Long
Dim m As Long
Dim n As Long
Dim j As Long
Dim lNumColumn As Long

Dim XLsheetD As String
Dim range_data As String

Dim tab_data()


Dim Data As ListObject
Dim track_list As ListObject

'ini Data

Set Data = Sheets("track_list").ListObjects("sheets_list")
Set track_list = Sheets("track_list").ListObjects("track_list")

Application.Goto Reference:=track_list
Column = ActiveCell.Column
Row = ActiveCell.Row - 1

range_data = "A9:A6000"

'import list

m = Data.ListRows.Count
nb_docs_prev = 0
n = 0
lNumColumn = Application.CountA(Sheets("track_list").Range("B6:Z6"))

For k = 1 To lNumColumn

If Range("B6").Offset(0, k - 1) = "manual" Then
GoTo nextcol
End If

n = 0

    For i = 1 To m

    XLsheetD = Data.DataBodyRange(i, 1)

    lNumCases = Application.CountA(Sheets(XLsheetD).Range(range_data))

    nb_docs = lNumCases - 1

    c = Data.DataBodyRange(i, k + 1)

    If c = "-" Then
    n = n + lNumCases
    GoTo nextsheet
    End If

    If k = 1 Then
    ReDim Preserve tab_data(lNumColumn, nb_docs + nb_docs_prev + 1)
    End If

        For j = 0 To nb_docs

        If Range("B6").Offset(0, k - 1) = "hyperlink" Then
        tab_data(k - 1, n) = ""
        Else
        tab_data(k - 1, n) = Sheets(XLsheetD).Range("A9").Offset(j, c - 1)
        End If

        n = n + 1

        Next j

    nb_docs_prev = nb_docs + nb_docs_prev + 1

nextsheet:

Next i

nextcol:

Next k

'Put data in order

lNumCases = track_list.ListRows.Count

'==>test if data already in the table

For p = 1 To n

For q = 1 To lNumCases

If track_list.DataBodyRange(q, 1) = tab_data(0, p - 1) Then

For r = 1 To lNumColumn

If Range("B6").Offset(0, r - 1) = "manual" Or Range("B6").Offset(0, r - 1) = "semi-automatic" Then
    If tab_data(r - 1, p - 1) <> "" Then
    Else
    tab_data(r - 1, p - 1) = track_list.DataBodyRange(q, r).Formula
    End If
End If

Next r

End If

Next q

Next p

' formulas for new lines

For p = 1 To n

tab_data(5 - 1, p - 1) = "=IF([@[DCN no]]<>"""",INDEX(DCN!R9C3:R229C3,MATCH([@[DCN no]],DCN!R9C1:R229C1,0)),"""")"
tab_data(11 - 1, p - 1) = "=IF([@[DCN no]]<>"""",IF(INDEX(DCN!R9C7:R229C7,MATCH([@[DCN no]],DCN!R9C1:R229C1,0))<>"""",""CLOSED"",""OPEN""),"""")"

Next p

'paste list

Application.Goto Reference:=track_list
Selection.ClearContents

track_list.Resize Range(Cells(Row, Column), Cells(Row + n, Column + track_list.ListColumns.Count - 1))

Application.Goto Reference:=track_list

Selection = Application.Transpose(tab_data())


Application.Calculation = xlAutomatic

End Sub

你知道為什么嗎 ？

在這樣做之前，我的宏正常工作。 只是那些公式無法粘貼。

謝謝

Answer 1

您的聲明

Range("S8:AY250") = Application.Transpose(tab_data())

只能用於將tab_data的值寫入工作表

您需要通過確定的Bruce Wayne方法將數組公式明確地寫入工作表。

Range("S8").formulaArray = "=IF([@[DCNno]]<>"""",INDEX(DCN!R9C3:R229C3,MATCH([@[DCNno]],DCN!R9C1:R229C1,0)),"""")"

將使您更接近想要的位置，但是上面的單元格引用無疑是錯誤的，並且由於您在數組元素中使用變量，因此我無法確定您實際需要的單元格