arrays - 如何从不相邻的表列创建多维数组

Question

我正在使用 Excel 中的表格，并希望将来自 3 个不相邻表格列的数据放入一个数组中。然后将该数组写入新工作簿的空白工作表中的 3 列 (A:C)，该工作簿另存为文本文件。
当我的表格列彼此相邻并按照我需要的顺序排列时，以下代码有效(使用辅助列实现)。

Sub TblToTxtFile()
'PURPOSE:   Create a txt file from the Excel table

    Dim xWB As Workbook:    Set xWB = ActiveWorkbook
    Dim xNum As Long
    Dim xArray As Variant
    Dim xWBNew As Workbook
    Dim xFileName As String:    xFileName = xWB.Path & "\" & Left(xWB.Name, 6) & " Import.txt"
    
    With xWB.Sheets("Entries").ListObjects("Entries Report")
        xNum = .DataBodyRange.Rows.count
        xArray = Union(.ListColumns("Account Number").DataBodyRange, .ListColumns("Amount2").DataBodyRange, .ListColumns("Item Description2").DataBodyRange).Value  '2 in the column name indicates a helper column
    End With
    
    Set xWBNew = Workbooks.Add
    
    With xWBNew.ActiveSheet
        .Range("A1:A" & xNum).NumberFormat = "0" 'Keeps account number from being converted to scientific numbers
        .Range("A1:C" & xNum) = xArray
    End With
    
    With xWBNew
        .SaveAs FileName:=xFileName, FileFormat:=xlText, CreateBackup:=False
        .Close savechanges:=False
    End With

End Sub

在最终项目中，重新排列或向表中添加辅助列将不是一种选择，因此我需要一个不需要更改原始表的解决方案。
当我尝试将未更改表中的数据(原始列中的原始列)提取到数组中时，数组中的所有 3 列都填充了第一列中的数据。

Answer 1

此代码会将您指定的任何列从表中复制到新工作簿中的相邻列。

Option Explicit

Sub TblToTxtFile()
'PURPOSE:   Create a txt file from the Excel table

Dim xWB As Workbook: Set xWB = ActiveWorkbook
Dim xNum As Long
Dim rngArea As Range
Dim rngCol As Range
Dim rngDst As Range
Dim rngSrc As Range
Dim xWBNew As Workbook
Dim xFileName As String: xFileName = xWB.Path & "\" & Left(xWB.Name, 6) & " Import.txt"

    With xWB.Sheets("Entries").ListObjects("Entries_Report")
        xNum = .DataBodyRange.Rows.Count
        Set rngSrc = Union(.ListColumns("Field1").DataBodyRange, .ListColumns("Field3").DataBodyRange, .ListColumns("Field4").DataBodyRange)
    End With

    Set xWBNew = Workbooks.Add

    Set rngDst = xWBNew.ActiveSheet.Range("A1:A" & xNum)

    For Each rngArea In rngSrc.Areas
        For Each rngCol In rngArea.Columns
            Debug.Print rngCol.Address
            With rngDst
                .NumberFormat = "0"    'Keeps account number from being converted to scientific numbers
                .Value = rngCol.Value
            End With

            Set rngDst = rngDst.Offset(, 1)
        Next rngCol
    Next rngArea

    With xWBNew
        .SaveAs Filename:=xFileName, FileFormat:=xlText, CreateBackup:=False
        .Close savechanges:=False
    End With

End Sub