Question

enter image description here

我有一张名为＆＃34; raw＆＃34;我想用按钮功能过滤它。 in＆＃34; raw＆＃34;表，这个表有随机标题。我想要做的是，当我点击按钮，然后新工作表＆＃34;过滤＆＃34;将使用表格生成标题更有条理。

我可以在按钮内创建新工作表，但生成有组织的表更难。我想问一下是否有可能创建这个表？我是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模块并粘贴下面的代码

如果工作表（＆＃34;过滤器＆＃34;）已经存在：

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

这将创建一个名为＆＃34; Filter＆＃34;

的新工作表

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所提到的，Macro Recorder将为您的所有手动操作生成代码，您只需要改进它就可以删除所有激活和选择语句

注意：一个表不能有2个相同的标题，因此移动列涉及创建新列，从初始列复制数据，然后＆＃34;记住＆＃34;标题名称，删除初始列，以及将新列的标题重命名为初始标题名称

Answer 2

就你在VBA学习3天而言，开始使用Macro录音机来完成这样的任务是一个非常好的主意，至少要有一个起点。这是Macro Recorder的一个简单示例：

Sub Makro1()
'
' Makro1 Makro
'

'
    Cells.Clear
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$13"), , xlNo).Name = _
        "Table1"
    Range("Table1[#All]").Select
    ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight9"
    Range("Table1[[#Headers],[Column1]]").Select
    ActiveCell.FormulaR1C1 = "Header1"
    Range("Table1[[#Headers],[Column2]]").Select
    ActiveCell.FormulaR1C1 = "Second Header"
    Range("Table1[[#Headers],[Column3]]").Select
    ActiveCell.FormulaR1C1 = "Third Header"
    Range("Table1[[#Headers],[Column4]]").Select
    ActiveCell.FormulaR1C1 = "Forth Header"
    Range("Table1[[#Headers],[Column5]]").Select
    ActiveCell.FormulaR1C1 = "Fifth Header"
    Range("A2").Select
End Sub

播放一下，看看它是如何工作的，使用 F8 。一段时间后，您可以寻找避免.Select和ActiveSheet的方法。这是一个可以根据标题行的数量通过循环进一步自动化的示例。但是，它不会使用ActiveSheet和Select：

Option Explicit

Sub TestMe()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets(1)
    Dim tbl As ListObject

    With ws
        .Cells.Clear
        .ListObjects.Add(xlSrcRange, .Range("A1:E10"), , xlNo).Name = "MyFirstTable"
        Set tbl = .ListObjects(1)

        tbl.HeaderRowRange.Cells(1, 1) = "SomeHeader1"
        tbl.HeaderRowRange.Cells(1, 2) = "SomeHeader2"
        tbl.HeaderRowRange.Cells(1, 3) = "SomeHeader3"
        tbl.HeaderRowRange.Cells(1, 4) = "SomeHeader4"
        tbl.HeaderRowRange.Cells(1, 5) = "SomeHeader5"            
    End With

End Sub

例如，如果你想循环标题并输入一些值，那么这就是With ws的内容：

With ws
    .Cells.Clear
    .ListObjects.Add(xlSrcRange, .Range("A1:E10"), , xlNo).Name = "MyFirstTable"
    Set tbl = .ListObjects(1)

    Dim myCell  As Range        
    For Each myCell In tbl.HeaderRowRange.Cells
        myCell = "SomeHeader " & myCell.Column
    Next myCell
End With

Excel-VBA：使用预定的表头生成工作表

2 个答案: