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

Question

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

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

这是我的代码：

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