Excel VBA - 循环过滤 table 列中的每个值并粘贴到相应的工作表中

Question

我正在尝试过滤第一个作品的 table sheet ("Data") 以过滤第二个作品的 table 中出现的每个项目sheet ("Hosts")，然后将过滤后的结果粘贴到单独的worksheets中，每一个都以table.

上对应的item命名

我对 VBA 的理解非常基础，我尝试将其他用户的代码拼贴在一起，但对我来说似乎效果不佳：

第一个循环根据 "Hosts" table 上的项目创建工作 sheets，但出于某种原因，它在我之前添加了一个额外的 sheet需要并称之为 "Sheet1"
第二个循环根本不起作用
是否真的需要两个循环，或者是否可以将两者结合起来？

这是我目前的代码：

Sub test()
Dim AllData As Worksheet
Dim HostList As Worksheet
Dim DataRange As Range
Dim FilterColumn As Long

Set AllData = ThisWorkbook.Worksheets("Data")
Set HostList = ThisWorkbook.Worksheets("Hosts")
Set DataRange = AllData.Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))

Dim HostValues As Range

For Each HostValues In HostList.ListObjects("Table1").Range

    With ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        On Error Resume Next
        ActiveSheet.Name = HostValues.Value
        If Err.Number = 1004 Then
            Debug.Print HostValues.Value & "already used as a sheet name"
        End If
        On Error GoTo 0
    End With

Next HostValues

For Each HostValues In HostList.ListObjects("Table1").Range
    AllData.Activate
    FilterColumn = 18
    DataRange.AutoFilter Field:=FilterColumn, Criteria1:=HostValues
        DataRange.SpecialCells(xlCellTypeVisible).Copy

    Sheets(HostValues.Text).Range("A1").PasteSpecial xlPasteValues
    Selection.Sort Key1:=Range("V:V"), Order1:=xlAscending, Header:=xlGuess

    AllData.Activate
    Cells.AutoFilter
Next HostValues
End Sub

请哪位好心人帮助我！

Answer 1

这里有很多事情要做，但我会试一试。

The first loop creates worksheets based on the items on the "Hosts" table, but for some reason it adds an extra sheet before the ones I need and calls it "Sheet1"

我的猜测是 Hosts 包含重复条目或某些原因导致 sheet 重命名部分失败。我会为此检查调试 window。或更改

Debug.Print HostValues.Value & "already used as a sheet name"

到

msgBox HostValues.Value & "already used as a sheet name"

这会弹出一个窗口，应该可以更容易地看到错误发生的时间。您可以尝试其他方法，用 ' 单引号注释掉两个 OnError 语句。然后，当出现错误时，您可以点击调试并解决程序的问题。

The second loop simply doesn't work

我不确定这个。当您多次使用 For Each 更改它正在操作的集合时，会给您带来某种问题。您已要求计算机对该列中的每个单元格执行某些操作，然后您更改了该列的值。这只是一个猜测。

Are two loops really necessary, or is it possible to combine the two?

您可以将两者结合起来，在为主机创建 sheet 之后，您可以将其数据移至其中。

备注

过滤方法可能会给您带来过度的复杂性，尝试编写一个没有过滤器的循环并检查主机是否有 sheet，如果它确实移动了数据。如果它不创建它并移动数据。
您根本不需要 With/End With 块。
On Error Resume Next 很危险。它有其用途，请查看 this 了解更多信息或处理错误。

祝你好运。

Excel VBA - 循环过滤 table 列中的每个值并粘贴到相应的工作表中

Excel VBA - Loop to filter table for each value in column and paste in according worksheet

excel

vba

loops

copy

worksheet

备注