☰

Power Query 可以调整为仅针对一张工作表吗？

tag-icon • tag-icon microsoft-excel vba macros merge power-query
Power Query 可以调整为仅针对一张工作表吗？

我有几千个 Excel 工作簿。每个 Excel 工作簿都有三个工作表，分别名为“站点”、“调查”和“项目信息”。我想将所有“调查”工作表合并到一个工作表中。我曾尝试使用 Power Query 来执行此操作，但这会导致整个工作簿被合并，并且我得到了奇怪的输出，其中我的“站点”和“项目信息”数据混合在我的“调查”数据中。有没有办法配置 Power Query，使其仅针对每个工作簿中特定命名的工作表？或者使用 VBA 更好地完成这项工作？

答案1

从多个文件导入工作表值（VBA 解决方案）

  • 仔细调整常量部分的值。
Option Explicit

Sub ImportWorksheets()
    
    ' Source
    Const sfPath As String = "C:\Test\" ' Folder Path
    Const sfPattern As String = "*.xls*" ' File Pattern
    Const swsName As String = "survey" ' Worksheet Name
    Const shrCount As Long = 1 ' Header Rows Count
    ' Destination
    Const dwsName As String = "survey" ' Worksheet Name
    Const dFirst As String = "A2" ' First Cell Address
    
    ' Destination
    
    ' Create references.
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
    Dim dCell As Range: Set dCell = dws.Range(dFirst)
    
    ' Turn off.
    Application.ScreenUpdating = False
    
    ' Clear.
    Dim dcrg As Range: Set dcrg = dCell.Resize(dws.Rows.Count - dCell.Row + 1)
    dcrg.EntireRow.Clear
   
    ' Source
    
    ' Get first file name.
    Dim sfName As String: sfName = Dir(sfPath & sfPattern)
    
    ' Declare variables.
    Dim swb As Workbook
    Dim sws As Worksheet
    Dim surg As Range
    Dim srg As Range
    Dim sFilePath As String
    
    ' Loop
    
    Do Until Len(sfName) = 0
        sFilePath = sfPath & sfName
        Set swb = Workbooks.Open(sFilePath)
        
        ' Validate worksheet.
        Set sws = Nothing
        On Error Resume Next
        Set sws = swb.Worksheets(swsName)
        On Error GoTo 0
        
        ' Copy by assignement (only values).
        If Not sws Is Nothing Then
            ' Read.
            Set surg = sws.UsedRange
            Set srg = surg.Resize(surg.Rows.Count - shrCount).Offset(shrCount)
            ' Write.
            dfCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
            ' Reference next Destination Cell.
            Set dCell = dCell.Offset(srg.Rows.Count)
        End If
        swb.Close SaveChanges:=False
        sfName = Dir
    Loop

    ' Turn on.
    Application.ScreenUpdating = True
    
    ' Inform.
    MsgBox "Worksheets imported.", vbInformation, "Import Worksheets"

End Sub

相关内容