在ListObject表列中创建所有表单的索引列表及其名称

时间:2016-03-29 14:01:13

标签: excel vba excel-vba listobject

我想在表格列中创建所有工作表的索引列表及其名称。

到目前为止,我已经编写了下面的代码,但它在引用行上给出了错误。

Dim ws As Worksheet, tbl As ListObject, i As Integer
Set ws = Sheets("Profile Management")
Set tbl = ws.ListObjects("sheets")
With tbl.ListRows
Do While .Count >= 1
.Item(1).Delete
Loop
End With

For i = 1 To Sheets.Count
"tbl.ListColumns(1).DataBodyRange = Sheets(i).Name"
Next I

我哪里错了?

2 个答案:

答案 0 :(得分:1)

以下内容更为简单。

    Sub GetWorksheetNames()
        Dim i As Long



        ThisWorkbook.Worksheets("Profile Management").Cells(1, 1).Value = "Worksheet Inventory"
        For i = 1 To ThisWorkbook.Worksheets.Count
            ThisWorkbook.Worksheets("Profile Management").Cells(i + 1, 1).Value = ThisWorkbook.Worksheets(i).Name
        Next i
    End Sub

答案 1 :(得分:0)

使用结构化(又名 ListObject )表会给VBA带来一些额外的顾虑。你无法以.DataBodyRange property的方式写信,而.DataBodyRane是ListObject的成员,而不是ListObject的ListColumns property

Option Explicit

Sub wqwe()
    Dim tbl As ListObject, i As Long, w As Long

    With Worksheets("Profile Management")
        With .ListObjects("sheets")
            'make sure there is at least 1 row in the databodyrange
            If .DataBodyRange Is Nothing Then _
                .ListRows.Add
            'clear the first column
            .DataBodyRange.Columns(1).ClearContents
            'insert the worksheet names
            For w = 1 To Worksheets.Count
                'except "Profile Management"
                If Worksheets(w).Name <> .Parent.Name Then
                    i = i + 1
                    'expand the table for new worksheets
                    .DataBodyRange.Cells(i, 1) = Worksheets(w).Name
                    'optionally insert a hyperlink to each worksheet's A1
                    .Parent.Hyperlinks.Add Anchor:=.DataBodyRange.Cells(i, 1), _
                        Address:=vbNullString, SubAddress:=Worksheets(w).Name & "!A1", _
                        TextToDisplay:=Worksheets(w).Name, ScreenTip:="click to go there"
                End If
            Next w
            'reshape the table if there are blank rows
            Do While i < .ListRows.Count
                .ListRows(i + 1).Delete
            Loop
        End With
    End With
End Sub

如上面的评论中所述,我已经添加了直接从表格列表中链接到每个工作表的选项。如果选择此路线,则不必先将名称放入表格单元格中。