Excel 从列中的唯一值创建新工作表并粘贴整行-大型数据集

我希望获得D列中的所有唯一值，并为每个唯一值创建一个具有该名称的新工作表，并将Sheet1中具有该值的所有行粘贴到该新工作表中。我已经找到了一个很好的解决方案，可以解决小数据集的问题，但它会使Excel在有大量行（10000+）的情况下崩溃。张露娜在这里给出了答案：

有没有办法缩短时间？我还在这里尝试了Profex提供的答案的变体：并改变了

Sheet.Range（DeleteAddress）.EntireRow.Delete

to

Sheet.Range(CopyAddress).EntireRow.Copy

Worksheets.Add After:=Sheets(Sheets.Count) 
Range("A1").Select
ActiveSheet.Paste

但它返回错误1004。

• 创建数据透视表
• 将数据的相关列作为一行。（下例中为F1）
• 计算此行的项目数

然后显示每个pivot元素的详细信息，或致电下面的Makro为您完成工作

---

我认为使用Autofilter提取相关条目比循环遍历每一行更有效。你应该能够在网上找到例子。另外，当处理大型数据集时，我建议不要处理工作表上的数据。将它们导入数组，然后在该数组上执行任务，然后再将所需数据复制回工作表。不过，在本例中，我将使用@SJRsuggestion@Zac-实际上你的方法可能更快…@SJR：没错，但是用你的方法，OP不需要在编码方面做太多工作。他们只需在一条语句中执行筛选并捕获结果。可能是优先于生产力的情况：）谢谢，但我不确定这是否行得通。D列中有很多可变实体，因此需要花费大量时间对每个实体进行过滤，并且在将数据分离到不同的表中后，我需要进行其他计算。

Sheet.Range(CopyAddress).EntireRow.Copy

Worksheets.Add After:=Sheets(Sheets.Count) 
Range("A1").Select
ActiveSheet.Paste

Sub CreatePivotTable()
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Sheet1!R3C1:R1048576C2", Version:=xlPivotTableVersion15).CreatePivotTable _
        TableDestination:=ActiveSheet.Range("A1"), TableName:="PivotTable1"
    With ActiveSheet.PivotTables("PivotTable1")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With

    With ActiveSheet.PivotTables("PivotTable1").PivotFields("F1")
        .Orientation = xlRowField
        .Position = 1
    End With

    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("F1"), "Count of F1", xlCount

    With ActiveSheet.PivotTables("PivotTable1").PivotFields("F1")
        .Orientation = xlRowField
        .Position = 1
    End With
End Sub


Public Sub ShowAllPTDetail()
    Dim WB As Workbook
    Dim actWs As Worksheet
    Dim ptCounter As Long
    Dim pt As PivotTable
    Dim dataRange As Range
    Set WB = ThisWorkbook

    Sheets(1).Activate
    Set actWs = ActiveSheet

    With actWs
        If .PivotTables.Count > 0 Then
            For ptCounter = 1 To .PivotTables.Count
                Set pt = .PivotTables(ptCounter)
                Set dataRange = Range(pt.TableRange1.Address)
                For detailCt = 3 To dataRange.Rows.Count - 1
                    .Activate
                    dataRange(detailCt, dataRange.Columns.Count).Select
                    Selection.ShowDetail = True
                Next detailCt
            Next
        End If
    End With
End Sub