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)),"""")"

让您更接近您想要的位置，但上面的单元格引用无疑是错误的，我无法确定您实际需要哪个单元格，因为您在数组元素中使用变量< / p>

Array VBA中的公式优秀

1 个答案: