VBA多维数组，为什么第二维的第一个值与第一维的第一个值重复

Question

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

​

​

cell A1实际上应该是HD电源，但由于某种原因，它被覆盖了？任何关于为什么会发生这种情况的帮助和提示都是非常感谢的。我是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代码：

ReDim code(1 To size, 1 To 2)

然后简单地给它赋值thuse：

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