在代码问题中使用 Union 将工作表与源工作表分开

Question

我有一个 Excel 工作簿，里面有 2 张纸。 一种称为“分组”，存储许多部门名称。 另一张表存储员工记录，如部门名称、年龄、姓名、薪水......

我想使用部门名称生成工作表

运行此代码时，它只为市场部门生成一张工作表 然后抛出一个错误。错误显示

对象“_Global”的方法“Union”失败。

谁能告诉我导致这个错误的问题？

Sub Extract()

Dim myCell As Range
Dim Rng As Range
Dim Rng_Del As Range
Dim source_sht As Worksheet
Dim use_sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim sheet_name As String
Dim gp_Lastrow As Long

gp_Lastrow = Worksheets("Grouping").Cells(Rows.Count, 1).End(xlUp).Row

For a = 2 To gp_Lastrow

    Set source_sht = Worksheets("Sheet1")
    source_sht.Copy After:=ThisWorkbook.Sheets(2)
    ActiveSheet.Name = Worksheets("Grouping").Range("A" & a).Value

    sheet_name = Worksheets("Grouping").Range("A" & a).Value
    Worksheets(sheet_name).Activate
    Set use_sht = Worksheets(sheet_name)

    Set StartCell = use_sht.Range("A2")
    LastRow = use_sht.Cells(use_sht.Rows.Count, StartCell.Column).End(xlUp).Row
    LastColumn = use_sht.Cells(StartCell.Row, use_sht.Columns.Count).End(xlToLeft).Column

    Set Rng = use_sht.Range(StartCell, use_sht.Cells(LastRow, LastColumn))

    If use_sht.AutoFilterMode = True Then
        use_sht.AutoFilter.ShowAllData
    End If

    Rng.AutoFilter field:=1, Criteria1:=Worksheets("Grouping").Range("A" & a).Value

    'Delete hidden rows
    For Each myCell In Rng.Columns(1).Cells
        If myCell.EntireRow.Hidden Then
            If Rng_Del Is Nothing Then
                Set Rng_Del = myCell
            Else
                Set Rng_Del = Union(Rng_Del, myCell)
            End If
        End If
    Next

    If Not Rng_Del Is Nothing Then Rng_Del.EntireRow.Delete

    use_sht.AutoFilterMode = False
Next a


End Sub

运行代码后，假设文件应包含以下表格。

例如：Grouping,Sheet1(Grouping and Sheet1是原始sheets 文件中的选项卡），市场部门（只有员工记录） 市场部相关）、人力资源（只有员工 与人力资源部有关的记录）、财务 部门，现金控制部门

未来如果公司扩张会增加更多部门。

Answer 1

您没有在工作表之间清除 Rng_Del，因此您试图合并两个不同工作表之间的范围：这就是引发错误的原因。

Set Rng_Del = Nothing '<<<<<<< clear before entering the loop
'Delete hidden rows
For Each myCell In Rng.Columns(1).Cells
    If myCell.EntireRow.Hidden Then
        If Rng_Del Is Nothing Then
            Set Rng_Del = myCell
        Else
            Set Rng_Del = Union(Rng_Del, myCell)
        End If
    End If
Next
If Not Rng_Del Is Nothing Then Rng_Del.EntireRow.Delete