在 ListObject table 列中使用其名称创建所有工作表的索引列表
Create a Index List of all Sheets with their name in ListObject table column
我想创建一个索引列表,其中包含在 table 列中包含其名称的所有工作表。
到目前为止,我已经编写了以下代码,但它在引用的行上给出了错误。
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
我哪里错了?
下面就简单多了
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
使用结构化(又名 ListObject)tables 给 VBA 带来了一些额外的问题。您不能写入 .DataBodyRange property that way and the .DataBodyRane is a member of the ListObject, not the ListObject's 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
如上面的评论所述,我添加了直接从其在 table 中的列表超链接到每个工作表的选项。如果您选择此路线,则不必先将名称放入 table 单元格。
我想创建一个索引列表,其中包含在 table 列中包含其名称的所有工作表。
到目前为止,我已经编写了以下代码,但它在引用的行上给出了错误。
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
我哪里错了?
下面就简单多了
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
使用结构化(又名 ListObject)tables 给 VBA 带来了一些额外的问题。您不能写入 .DataBodyRange property that way and the .DataBodyRane is a member of the ListObject, not the ListObject's 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
如上面的评论所述,我添加了直接从其在 table 中的列表超链接到每个工作表的选项。如果您选择此路线,则不必先将名称放入 table 单元格。