Question

我试图从一个工作簿获取信息，将其转换为数组（2D），将第一列（标识符）添加到标识符数组，匹配并粘贴到excel。该代码为基本组织提供了一些额外的行。

目前的问题是，在IsInArray函数中，我得到一个“未定义的下标”，因为'for position = LBound（arr）到UBound（arr）'。

对可能发生的事情有所了解？

Sub Pr()
Dim w As Workbook
Set w = ThisWorkbook
Dim w2 As Workbook
Dim end1 As Long, end2 As Long, i As Long, lRow As Long, lColumn As Long, t     As Long, k As Long, position As Long, g As Long
Dim WBArray() As Variant
Dim IS() As Variant
Dim ws As Worksheet

end1 = ThisWorkbook.Worksheets(1).UsedRange.Rows.count

Dim MyFolder As String
Dim MyFile As String

'Optimize Macro Speed Start
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

'opens the first workbook file
For i = 2 To ThisWorkbook.Sheets("FILES").Cells(1, 2).Value

    Workbooks.Open Filename:=ThisWorkbook.path & "\" & ThisWorkbook.Sheets("FILES").Cells(i, 1).Value

    Set w2 = ActiveWorkbook
    ActiveSheet.Range("A:A").Select

    'text to columns
    Selection.TextToColumns destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=True, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
        , 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17 _
        , 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27 _
        , 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1),   Array(32, 1)), TrailingMinusNumbers:=True

    end2 = ActiveSheet.UsedRange.Rows.count

'transform it to array
    WBArray = ActiveSheet.Range(Cells(5, 1), Cells(end2, 29)).Value

'loop to match information in two arrays

    For lRow = 2 To UBound(WBArray)
        If IsInArray((WBArray(lRow, 1)), IS) <> -1 Then
            t = IsInArray((WBArray(lRow, 1)), IS)

'start the information pasting procedure:
            w.Sheets("C").Cell(t, i + 3) = WBArray(lRow, 11)
            w.Sheets("M").Cell(t, i + 3) = WBArray(lRow, 12)
            w.Sheets("W t-1").Cell(t, i + 3) = WBArray(lRow, 13)
            w.Sheets("P").Cell(t, i + 3) = WBArray(lRow, 14)
            w.Sheets("A").Cell(t, i + 3) = WBArray(lRow, 15)
            w.Sheets("PC").Cell(t, i + 3) = WBArray(lRow, 16)
            w.Sheets("AM").Cell(t, i + 3) = WBArray(lRow, 17)
            w.Sheets("AM t-1").Cell(t, i + 3) = WBArray(lRow, 18)
            w.Sheets("P t-1").Cell(t, i + 3) = WBArray(lRow, 19)
            w.Sheets("F").Cell(t, i + 3) = WBArray(lRow, 20)
            w.Sheets("F t-1").Cell(t, i + 3) = WBArray(lRow, 21)
            w.Sheets("A t-1").Cell(t, i + 3) = WBArray(lRow, 22)
            w.Sheets("S").Cell(t, i + 3) = WBArray(lRow, 23)

        Else

'add it to the end of ISArray
            ReDim Preserve IS(1 To UBound(IS) + 1)
            IS(UBound(IS)) = WBArray(lRow, 1)
            k = UBound(IS)

            w.Sheets("C").Cell(k, i + 3) = WBArray(lRow, 11)
            w.Sheets("M").Cell(k, i + 3) = WBArray(lRow, 12)
            w.Sheets("W t-1").Cell(k, i + 3) = WBArray(lRow, 13)
            w.Sheets("P").Cell(k, i + 3) = WBArray(lRow, 14)
            w.Sheets("A").Cell(k, i + 3) = WBArray(lRow, 15)
            w.Sheets("PC").Cell(k, i + 3) = WBArray(lRow, 16)
            w.Sheets("AM").Cell(k, i + 3) = WBArray(lRow, 17)
            w.Sheets("AM t-1").Cell(k, i + 3) = WBArray(lRow, 18)
            w.Sheets("P t-1").Cell(k, i + 3) = WBArray(lRow, 19)
            w.Sheets("F").Cell(k, i + 3) = WBArray(lRow, 20)
            w.Sheets("F t-1").Cell(k, i + 3) = WBArray(lRow, 21)
            w.Sheets("A t-1").Cell(k, i + 3) = WBArray(lRow, 22)
            w.Sheets("S").Cell(k, i + 3) = WBArray(lRow, 23)

        End If

  Next lRow
'copy the file date from each source workbook to output workbook
'if the control sheet name (FILES) is changed, please change it in this loop

        For Each ws In w.Worksheets

            If ws.Name <> "FILES" Then

                ws.Cells(1, i + 3) = w2.Worksheets(1).Cells(1, 2)

            End If

        Next ws

Next i

'paste the is array to all worksheets

    g = UBound(IS)
    For Each ws In ActiveWorkbook.Worksheets

        Range("A1:A" & g) = IS()

    Next ws

'Optimize Macro Speed
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic

'Close file and save
'w.Close True


End Sub



Function IsInArray(stringToBeFound As String, arr As Variant) As Long
Dim position As Long
'default return value if value not found in array
IsInArray = -1

For position = LBound(arr) To UBound(arr) 'subscript out of range
    If arr(position) = stringToBeFound Then
        IsInArray = position + 1
        Exit For
    End If
Next

End Function

Answer 1

您的问题是，当您测试未分配数组的{"data":[ {"id":"id1","attributes":{"name":"gnu"}}, {"id":"id2","attributes":{"name":"Alice"}}, {"id":"id3","attributes":{"name":"testsubject"}}, {"id":"id4","attributes":{"name":"testissuer"}} ]}时，您将收到错误消息。第一次通过LBOUND函数就是这种情况。

由于不鼓励链接到外部网站，我已经在VBA Arrays

上复制了Chip Pearson网站页面上的IsInArray功能

更改您的IsArrayEmpty功能，如下所示（并添加IsInArray功能，如下所示：

IsArrayEmpty

Answer 2

在你的函数IsInArray中，你可以试试这个：

Function IsInArray(stringToBeFound As String, arr As Variant) As Long
Dim position As Long
Dim returnValue as Long
'default return value if value not found in array
returnValue  = -1

For position = LBound(arr) To UBound(arr) 'subscript out of range
    If arr(position) = stringToBeFound Then
        returnValue  = position + 1
        Exit For
    End If
Next

IsInArray = returnValue

End Function`

我想当你写：IsInArray = -1时，你正在结束你的功能。

使用两个数组操作工作簿数据

2 个答案: