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

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

2 个答案: