VBA多维数组，为什么第二维的第一个值被复制到第一维的第一个值

Question

我在这里不知所措。我有一个宏，它将两组数据存储到一个多维数组中，然后打开一个新工作簿，并循环遍历将数据放入单元格的数组。我遇到的问题是数组的第一个维度中的第一个条目是第二个维度的第一个条目的副本。这是结果的图像：

单元格 A1 实际上应该是 HD Supply，但由于某种原因它被覆盖了？任何有关为什么会发生这种情况的帮助，以及提示非常感谢。我对 VBA 比较陌生，多维数组对我来说有些陌生，所以我认为这与我的拉函数和多维数组的设置有关。

这是我的代码：

Option Explicit

'Variable Definitions ***********************************************************
Dim WorkbookSize As Long 'Var to hold number of rows in worksheet, used primarily to control loops
Dim wb As Workbook 'var to hold workbook object
Dim TempPath As String 'var to hold local temp path to store newly created workbook
Dim i As Integer 'var used as counter for loops
Dim c As Integer 'var used as counter for loops
Dim activeBook As String 'var to hold new workbook name
Dim values() 'array for pull data

'Main Driver
Sub Main()
    'set current workbook as active workbook
    Dim currentWorksheet As Worksheet
    Set currentWorksheet = ActiveSheet

    WorkbookSize = size(currentWorksheet) 'Run function to get workbook size

    values = pull(currentWorksheet, WorkbookSize) 'Run sub to pull data
    push create(), values
End Sub

'Get size of Worksheet
Function size(sh As Worksheet) As Long
    size = sh.Cells(Rows.Count, "A").End(xlUp).Row
End Function

'Create workbook
Function create() As Workbook
    Set wb = Workbooks.Add
    TempPath = Environ("temp") 'Get Users local temp folder
    With wb
        .SaveAs Filename:=TempPath & "EDX.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
        .ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
    End With

    Set create = wb
End Function

'pull data
Function pull(pullFromSheet As Worksheet, size) As Variant
    Dim code() As Variant
    ReDim code(size - 1, size - 1)
    c = 1
    For i = 1 To size
    'Check code column for IN and Doctype column for 810
        If pullFromSheet.Cells(i, 9).Value = 810 And pullFromSheet.Cells(i, 17).Value = "IN" Then
            code(c - 1, 0) = pullFromSheet.Cells(i, 3).Value 'store in array
            code(0, c - 1) = pullFromSheet.Cells(i, 18).Value 'store in array
            c = c + 1
        End If
    Next i
    pull = code
End Function

'push data to new workbook
Sub push(toWorkbook As Workbook, ByRef code() As Variant)
    'activeBook = "TempEDX.xlsm"

    'Workbooks(activeBook).Activate 'set new workbook as active book
    Dim newSheet As Worksheet
    Set newSheet = toWorkbook.Sheets(1)
    Dim txt As String
    For i = 0 To UBound(code)
        newSheet.Cells(i + 1, 1).Value = code(i, 0)
        newSheet.Cells(i + 1, 2).Value = code(0, i)
    Next i
    newSheet.Activate 'make new sheet active for the user
End Sub

Answer 1

您真的需要数组中对角线的数据吗？在第一个循环之后，您填充code(1,0) 和code(0,1)，然后是code(2,0) 和code(0,2)，然后是code(3,0) 和code(0,3) 等等...

您生成的表表明情况并非如此。我会使用以下代码：

ReDim code(size - 1, 2)
For i = 1 To size
'Check code column for IN and Doctype column for 810
    If pullFromSheet.Cells(i, 9).Value = 810 And pullFromSheet.Cells(i, 17).Value = "IN" Then
        code(i - 1, 0) = pullFromSheet.Cells(i, 3).Value 'store in array
        code(i - 1, 1) = pullFromSheet.Cells(i, 18).Value 'store in array
    End If
Next i

Answer 2

我认为您误解了二维数组的工作原理。第一个是“行”的数量，第二个是“列”的数量，不是每个都是它自己的列。

所以你想重新编译代码：

ReDim code(1 To size, 1 To 2)

然后简单地分配它：

Function pull(pullFromSheet As Worksheet, size) As Variant
    Dim code() As Variant
    ReDim code(1 To size, 1 To 2)
     For i = 1 To size
    'Check code column for IN and Doctype column for 810
        If pullFromSheet.Cells(i, 9).Value = 810 And pullFromSheet.Cells(i, 17).Value = "IN" Then
            code(i, 1) = pullFromSheet.Cells(i, 3).Value  'store in array
            code(i, 2) = pullFromSheet.Cells(i, 18).Value 'store in array
         End If
    Next i
    pull = code
End Function

然后在将值分配给不需要循环的新工作表时，只需将其分配给范围即可：

Sub push(toWorkbook As Workbook, ByRef code() As Variant)
    'activeBook = "TempEDX.xlsm"

    'Workbooks(activeBook).Activate 'set new workbook as active book
    Dim newSheet As Worksheet
    Set newSheet = toWorkbook.Sheets(1)
    newSheet.Range("A1").Resize(UBound(code, 1), 2).Value = code
    newSheet.Activate 'make new sheet active for the user
End Sub