根据列值拆分 excel 文件答案

【问题标题】：Split an excel file based on column values根据列值拆分 excel 文件
【发布时间】：2022-11-14 19:00:02
【问题描述】：

我有一个 excel 数据文件，其中包含 2 个名为“数据”和“GL 数据”的工作表

这两张表都包含一个名为“Leader”的列，该列有 4 个不同的名称 - 例如 D1、D2、D3 和 D4

我还有其他 4 个名为 Data_D1、Data_D2、Data_D3 和 Data_D4 的工作簿，每个工作簿都有 2 个名为“Data”和“GL Data”的工作表。

我需要将每个领导者的数据放在他们的工作表中。那是：

1-在工作表“数据”中的领导列上应用过滤器并选择 D1

2- 将过滤后的行复制到工作簿 Data_D1 的“数据”表

3- 在工作表“GL 数据”中的领导列上应用过滤器并选择 D1

4-将过滤后的行复制到工作簿 Data_D1 的“GL 数据”表

5- 对 D2、D3 和 D4 重复上述步骤

我想知道是否有更好的方法可以快速做到这一点。我在网上搜索但找不到任何东西。任何帮助都会很有用。谢谢你。

编辑：写了一些 VBA 代码（见下面的答案）。它的工作面临一些问题。

【问题讨论】：

嗨阿德南！你能分享一些你的工作簿或工作表的样本，至少一些图片。
嗨 Mohamad，我为此写了一些 VBA，但有一些问题。让我知道您是否可以提供帮助。在下面的答案中发布代码。

标签： excel vba powerquery

【解决方案1】：

我编写了以下代码，但我似乎无法弄清楚为什么第二次循环第二次运行时，过滤后的值没有被复制。我需要重置过滤器还是什么？第一个循环似乎正在工作。

Sub foo()
    Dim yr As String
    Dim lastPd As String
    Dim thisPd As String
    Dim x As Workbook
    Dim y As Workbook
    Dim vals As Variant
    Dim lr As Long
    Dim strNames(1 To 4) As String
    Dim fileNames(1 To 4) As String
    Dim path As String
    Dim sourceFileName As String
    Dim i As Integer
    Dim j As Integer
    
    yr = "2022"
    sourceFileName = "sourcefilename.xlsx"
    path = "path to the file"
    
    'populate the arrays
    strNames(1) = "D1"
    strNames(2) = "D2"
    strNames(3) = "D3"
    strNames(4) = "D4"
    
    fileNames(1) = "Data_D1.xlsx"
    fileNames(2) = "Data_D2.xlsx"
    fileNames(3) = "Data_D3.xlsx"
    fileNames(4) = "Data_D4.xlsx"
    
            
    For i = 1 To 4
     Set x = Workbooks.Open(path & sourceFileName)
     x.Activate
     Sheets("DATA").Activate
     lr = Cells(Rows.Count, 1).End(xlUp).Row
     Set y = Workbooks.Open(path & fileNames(i))
     x.Sheets("DATA").Range("A1:N" & lr).AutoFilter Field:=14, Criteria1:=strNames(i)
     x.Sheets("DATA").Range("A1:L" & lr).SpecialCells(xlCellTypeVisible).Copy
     y.Sheets("DATA").Cells(1, 1).PasteSpecial
    Next i
    
            
    For j = 1 To 4
     Set x = Workbooks.Open(path & sourceFileName)
     x.Activate
     Sheets("GL Data").Activate
     lr = Cells(Rows.Count, 1).End(xlUp).Row
     Set y = Workbooks.Open(path & fileNames(j))
     x.Sheets("GL Data").Range("A1:P" & lr).AutoFilter Field:=15, Criteria1:=strNames(j)
     x.Sheets("GL Data").Range("A1:L" & lr).SpecialCells(xlCellTypeVisible).Copy
     y.Sheets("GL Data").Cells(1, 1).PasteSpecial
    Next j
   
End Sub

【讨论】：