vba - Excel-VBA : Generate sheet with predetermined table header

Question

我有名为“raw”的工作表，我想使用按钮功能对其进行过滤。在“原始”表中，该表具有随机标题。我想要做的是，当我单击按钮时，将生成新的工作表“过滤器”，其中表头更有条理。

我可以在按钮内创建新工作表，但生成有组织的表格更难。我想问是否可以创建这个表？我是一名 VBA 学习者，有兴趣了解更多关于 VBA 编程的知识。

顺便说一句，我尝试使用

Dim Ws As Worksheet
Set Ws = ThisWorkbook.Sheets("Sheet_Name")

Ws.ListObjects.Add(xlSrcRange, Ws.Range("A$xx:$V$xx"), , xlYes).Name = "New_Table_Name"
Ws.ListObjects("New_Table_Name").TableStyle = "TableStyleLight1"

我仍然无法命名列表标题。

Answer 1

创建一个新的标准 VBA 模块并粘贴下面的代码

如果 Worksheets("Filter") 已经存在:

Option Explicit

Public Sub CopyTable()      'Worksheets("Filter") exists

    Const TBL_ID = "New_Table_Name"
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Worksheets("Raw")
    Set ws2 = ThisWorkbook.Worksheets("Filter")

    Application.ScreenUpdating = False
    ws1.ListObjects(1).Range.Copy
    With ws2
        .Cells(1).PasteSpecial Paste:=xlPasteAll
        .Cells(1).PasteSpecial Paste:=xlPasteColumnWidths
        .Cells(1).Select
        .ListObjects(1).Name = TBL_ID
        MoveTableCols ws2, TBL_ID       'calls 3rd Sub **************
    End With
    Application.ScreenUpdating = True
End Sub

这将创建一个名为“过滤器”的新工作表

Public Sub CopyWs()         'Creates a new Worksheets("Filter")

    Const TBL_ID = "New_Table_Name"
    Dim ws1 As Worksheet, ws2 As Worksheet, wsCount As Long

    Application.ScreenUpdating = False
    With ThisWorkbook
        Set ws1 = .Worksheets("Raw")
        ws1.Copy After:=.Worksheets(.Worksheets.Count)
        wsCount = .Worksheets.Count
        Set ws2 = .Worksheets(wsCount)
    End With
    ws2.Name = "Filter"
    ws2.ListObjects(1).Name = TBL_ID
    MoveTableCols ws2, TBL_ID           'calls 3rd Sub **************
    Application.ScreenUpdating = True
End Sub

Sub bellow 被上面的两个 Subs 调用，并重新组织新表

'Called by CopyTable() and CopyWs() Subs

Private Sub MoveTableCols(ByRef ws As Worksheet, ByVal tblId As String)

    Dim arr As Variant

    With ws
        .Rows(4).Delete Shift:=xlUp 'To delete rows based on criteria use Autofilter

        .ListObjects(tblId).ListColumns.Add Position:=6

        arr = .ListObjects(tblId).ListColumns(1).DataBodyRange
        .ListObjects(tblId).ListColumns(6).DataBodyRange = arr

        arr = .Cells(1)
        .Columns(1).Delete Shift:=xlToLeft
        .Cells(5) = arr
    End With
End Sub

正如 Vityata 所提到的，宏记录器将为您的所有手动操作生成代码，您只需要改进它即可删除所有激活和选择语句

备注 :一个表不能有 2 个相同的标题，因此移动一个列需要创建一个新列，从初始列复制数据，然后“记住”标题名称，删除初始列，并将新列的标题重命名为初始列标题名称