Question

我有2张纸的Excel工作簿。一种称为“分组”，并存储许多部门名称。其他工作表存储员工记录，例如部门名称，年龄，姓名，薪水……。

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

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

对象'_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

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

例如：分组，Sheet1（分组和Sheet1是原始工作表标签中的标签），市场部门（只有员工记录与市场部门有关），人力资源（只有员工）与人力资源部相关的记录），财务部门，现金控制部门

如果公司扩展，将来还会增加更多部门。

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

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

1 个答案: