从列标题创建 VBA 数组？

Question

我有一个导出“NewExport”，它总是随机化我收到的数据列。我需要这些列与“TheOrder”中的列顺序对齐，因此此代码将有助于重新组织导出以与我已经构建的列标题对齐。

我有 132 列需要重新对齐，虽然我可以全部输入，但必须有一种更简单的方法来对齐我已经创建的列标题。需要注意的是，下面的代码是从另一个 StackOverflow 答案中无耻地复制/粘贴的。

Sub OrderColumns(ByVal NewExport As Workbook, ByVal TheOrder As Worksheet)

Dim correctOrder() As Variant
Dim lastCol As Long
Dim headerRng As Range, cel As Range
Dim mainWS As Worksheet

Set mainWS = NewExport.Worksheets("Sheet1")

'Need to figure out how to make this an array based on a Range
correctOrder() = Array(TheOrder.Range("A1:A132").Value)

With mainWS
    lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set headerRng = .Range(.Cells(1, 1), .Cells(1, lastCol))
End With

Dim newWS As Worksheet
Set newWS = Ninja.Sheets.Add
newWS.Name = "Rearranged Sheet"

Dim col As Long
With newWS
    For col = 1 To lastCol
        For Each cel In headerRng
            If cel.Value = correctOrder(col - 1) Then
                mainWS.Columns(cel.Column).Copy .Columns(col)
                Exit For
            End If
        Next cel
    Next col
End With

End Sub

Answer 1

虽然它不像我希望的那样自动化（并且需要一个硬编码），但我能够找到这样的解决方案：

Dim correctOrder(132) As Variant 
'132 will need to be changed if there's ever any more/less columns added/excluded

For i = 1 To 132
    correctOrder(i - 1) = TheOrder.Range("A" & i).Value
Next

此解决方案为我提供了我正在寻找稍后使用的数组。

Answer 2

我最近为我的一个项目编写了一个“列查找器”功能。

我已对其进行了修改以满足您的以下要求。

• 该功能要求您传递正确排序的标题所在的工作簿以进行捕获。您可以将其修改为需要您的 TargetWorksheet，以使其更具动态性。
• 该函数返回单个维度Array。
• 该函数在Target Worksheet 中查找最后使用的列，允许更改列标题的数量（如您自己的答案中所述，其中列号已硬编码）。

Public Function CorrectOrderHeadingsArrayFunction(ByRef TargetWorkbook As Workbook) As Variant()
    With TargetWorkbook.Sheets(1) 'Change this to target your correct sheet
        Dim LastColumn As Long
        LastColumn = .Cells(1, .Columns.Count).End(xlToLeft).Column
        CorrectOrderHeadingsArrayFunction= Application.Transpose(Application.Transpose(.Range(.Cells(1, 1), .Cells(1, LastColumn)).Value)) 'This returns the array as single dimension rather than 2D
    End With
End Function

---

例如，下面是一些示例“测试”代码来展示使用此功能的概念。

您可以这样称呼它，并循环遍历每个元素，或许将另一个数组元素与正确的 order 元素进行比较，并在找到正确的 order 值时执行某些操作。

Sub TestSub()

    Dim CorrectOrderArray As Variant
    Dim TargetCorrectOrderElement As Variant
    Dim RandomOrderArray As Variant
    Dim TargetRandomOrderElement As Variant
 
    CorrectOrderArray = CorrectOrderHeadingsArrayFunction(Workbooks("Export (4).csv"))  'Change this to target your correct workbook
    RandomOrderArray = Sheet1.Range("A1:AZ1000")  'Change this to target the correct range for your data.
    
    For Each TargetCorrectOrderElement In CorrectOrderArray
        For TargetRandomOrderElement = LBound(RandomOrderArray) To UBound(RandomOrderArray)
            If RandomOrderArray(TargetRandomOrderElement) = TargetCorrectorderValue Then
                'Do some code to write that column to your worksheet
                Exit For  'Leaves the current iteration of the random order array loop to go to the next iteration of the correct order array
            End If
        Next TargetRandomOrderElement
    Next TargetCorrectOrderElement
End Sub