如何在代码中添加更多标题以提取数据答案

【问题标题】：How to add more header in the code to extract the data如何在代码中添加更多标题以提取数据
【发布时间】：2022-08-03 16:27:13
【问题描述】：

我正在努力解决这个问题，但它超出了我的知识范围。

我想通过在代码中添加\"Header Name\" 来提取更多列数据。但我的代码仅适用于单个标题。

我试图添加一个这样的数组

Const sHeader As String = Array(\"Category\", \"Names\") 等等。

但我得到一个错误。

我想Add File Names 在文件夹中循环浏览它们并跳过其余文件。

比如这个Const sFileName As String = Array(\"File1\", \"File2\")等等。

如果有人可以帮助我，我将不胜感激。

Sub ImportColumns()
    
    \' Source
    Const sFilePattern As String = \"*.xlsx\"
    Const sExceptionsList As String = \"Sheet1\" \' comma-separated, no spaces
    Const sHeader As String = \"Category\"
    Const sHeaderRow As Long = 1
    \' Destination
    Const dColumn As String = \"A\"
    
    \' Source
    
    Dim sfd As FileDialog
    Set sfd = Application.FileDialog(msoFileDialogFolderPicker)
    \'sfd.InitialFileName = \"C:\\Test\\\"
    
    Dim sFolderPath As String
    
    If sfd.Show Then
        sFolderPath = sfd.SelectedItems(1) & Application.PathSeparator
    Else
        \'MsgBox \"You canceled.\", vbExclamation
        Beep
        Exit Sub
    End If
    
    Dim sFileName As String: sFileName = Dir(sFolderPath & sFilePattern)
    
    If Len(sFileName) = 0 Then
        \'MsgBox \"No files found.\", vbExclamation
        Beep
        Exit Sub
    End If
    
    Dim sExceptions() As String: sExceptions = Split(sExceptionsList, \",\")
    
    \' Destination
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook \' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.ActiveSheet \' improve!
    Dim dfCell As Range
    Set dfCell = dws.Cells(dws.Rows.Count, dColumn).End(xlUp).Offset(1)
    
    \' Loop.
    
    Application.ScreenUpdating = False
    
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim srg As Range
    Dim shrg As Range
    Dim sData() As Variant
    Dim sfCell As Range
    Dim slCell As Range
    Dim srCount As Long
    Dim wsCount As Long
    
    Do While Len(sFileName) > 0
        Set swb = Workbooks.Open(sFolderPath & sFileName)
        For Each sws In swb.Worksheets
            If IsError(Application.Match(sws.Name, sExceptions, 0)) Then
                Set shrg = sws.Rows(sHeaderRow)
                Set sfCell = shrg.Find(sHeader, shrg.Cells(shrg.Cells.Count), _
                        xlFormulas, xlWhole)
                If Not sfCell Is Nothing Then
                    Set sfCell = sfCell.Offset(1)
                    Set slCell = sfCell _
                        .Resize(sws.Rows.Count - sHeaderRow) _
                        .Find(\"*\", , xlFormulas, , , xlPrevious)
                    If Not slCell Is Nothing Then
                        srCount = slCell.Row - sHeaderRow
                        Set srg = sfCell.Resize(srCount)
                    End If
                End If
                If srCount > 0 Then
                    If srCount = 1 Then
                        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
                    Else
                        sData = srg.Value
                    End If
                    dfCell.Resize(srCount).Value = sData
                    Set dfCell = dfCell.Offset(srCount)
                    wsCount = wsCount + 1
                    srCount = 0
                End If
            End If
        Next sws
        swb.Close SaveChanges:=False
        sFileName = Dir
    Loop
                
    \' Save the destination workbook.
    \'dwb.Save
                
    Application.ScreenUpdating = True
    
    MsgBox wsCount & \" \'\" & sHeader & \"\' columns copied.\", vbInformation
                
End Sub

将 VBA 中的 Array 更多地视为函数调用，而不是编译器指令（因为它是）。由于 Const 不能执行函数调用并且必须是常量，因此您不能以这种方式初始化数组。
那么如果不可能的话，如何初始化数组。我会很感激你的帮助。
对此@VBasic2008 的任何帮助

标签： excel vba

【解决方案1】：

使用Const 初始化数组的一个建议是以这种方式声明标题：

Const ALL_HEADERS As String = "Category,Names"

然后，当您设置阵列时，它将是：

Dim sHeader() As String
sHeader = Split(ALL_HEADERS, ",")

你的数组已经设置好了。

【讨论】：

谢谢我这样做了，然后将相同的逻辑应用于列。如果需要搜索两个标题，则数据将粘贴到 2 个单独的列中。但是这个东西不适用于列