我在不同作業表中的作業簿中有多個表格。如圖所示，所有表格范圍都是 Workbook。
使用 VBA，有沒有辦法讓這個物件分配給一個不定義SheetName的情況下將此物件分配給ListObject變數？
uj5u.com熱心網友回復：
如果我說對了，并且根據您的螢屏截圖，您可以使用以下代碼tblStage
Dim lo As ListObject
Set lo = Range("tblStage").ListObject
閱讀材料1 2
uj5u.com熱心網友回復：
在作業表未知時參考 Excel 表
什么時候有用？
當有人可能會重命名作業表或將表格移動到另一個作業表時，因為您通常想要這樣做，例如：
Dim tbl As ListObject Set tbl = ThisWorkbook.Worksheets("Sheet1").Listobjects("Table1")在第二種情況下，即使使用作業表代碼名稱也不會拯救您，例如：
Set tbl = Sheet1.ListObjects("Table1")
方法（緊湊）
Sub TableByName()
Const TableName As String = "Table1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Prevent "RTE '1004': Method 'Range' of object '_Global' failed"
' when the wrong workbook is active:
If Not wb Is ActiveWorkbook Then wb.Activate
Dim tbl As ListObject
On Error Resume Next
Set tbl = Range(TableName).ListObject
On Error GoTo 0
If tbl Is Nothing Then Exit Sub ' table not found
With tbl
Debug.Print .Name, .Range.Worksheet.Name, .Range.Address, _
.DataBodyRange.Address, .ListRows.Count, .ListColumns.Count
End With
End Sub
使用函式
Sub SetTableByNameExample()
Const TableName As String = "Table1"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim tbl As ListObject: Set tbl = SetTableByName(wb, TableName)
If tbl Is Nothing Then Exit Sub ' table not found
With tbl
Debug.Print .Name, .Range.Worksheet.Name, .Range.Address, _
.DataBodyRange.Address, .ListRows.Count, .ListColumns.Count
End With
End Sub
Function SetTableByName( _
ByVal wb As Workbook, _
ByVal TableName As String) _
As ListObject
' Prevent "RTE '1004': Method 'Range' of object '_Global' failed"
' when the wrong workbook is active:
If Not wb Is ActiveWorkbook Then wb.Activate
On Error Resume Next
SetTableByName = Range(TableName).ListObject
On Error GoTo 0
End Function
uj5u.com熱心網友回復：
Range("Table1").ListObject將回傳對 ListObject 的參考。但我永遠不會使用它，因為它只適用于 ActiveWorkbook。IMO，最好撰寫一個函式以從作業簿中回傳 ListObjects 的集合：
Function ListObjects(Optional wb As Workbook) As Collection
If wb Is Nothing Then Set wb = ActiveWorkbook
Dim Objects As New Collection
Dim ws As Worksheet
Dim ListObject As ListObject
Dim Collection As New Collection
For Each ws In wb.Worksheets
For Each ListObject In ws.ListObjects
Collection.Add ListObject, ListObject.Name
Next
Next
Set ListObjects = Collection
End Function
從我的個人宏作業簿中，我運行代碼，該代碼為作業簿中的每個 ListObject 創建/更新具有函式的模塊。我只需激活作業簿并UpdateListObjects從即時視窗運行。
注意：需要啟用對Microsoft Visual Basic for Applications Extensibility 5.3的參考和對 VBA 專案物件模型的信任訪問。
Sub UpdateListObjects(Optional wb As Workbook, Optional ModuleName As String = "TableDefs")
Const WarningMessage As String = "Rem This Module is auto updated" & vbNewLine & "Rem Do Not Edit!!" & vbNewLine
If wb Is Nothing Then Set wb = ActiveWorkbook
Dim Map As Collection
Set Map = ListObjects(wb)
If Map.Count = 0 Then Exit Sub
ReDim TableDefs(0 To Map.Count) As String
TableDefs(0) = WarningMessage
Dim n As Long
For n = 1 To Map.Count
TableDefs(n) = TableDef(Map(n))
Next
With TableDefVBComponent(wb, ModuleName).CodeModule
.DeleteLines 1, .CountOfLines
.AddFromString Join(TableDefs, String(2, vbNewLine))
End With
End Sub
Function ListObjects(Optional wb As Workbook) As Collection
If wb Is Nothing Then Set wb = ActiveWorkbook
Dim Objects As New Collection
Dim ws As Worksheet
Dim ListObject As ListObject
Dim Collection As New Collection
For Each ws In wb.Worksheets
For Each ListObject In ws.ListObjects
Collection.Add ListObject, ListObject.Name
Next
Next
Set ListObjects = Collection
End Function
Function TableDef(ListObject As ListObject) As String
Dim ws As Worksheet
Set ws = ListObject.Parent
Dim Lines(2) As String
Lines(0) = "Function " & ListObject.Name & "() As ListObject"
Lines(1) = vbTab & "set " & ListObject.Name & " = " & ws.CodeName & ".ListObjects(" & Chr(34) & ListObject.Name & Chr(34) & ")"
Lines(2) = "End Function "
TableDef = Join(Lines, vbNewLine)
End Function
Private Function TableDefVBComponent(Optional wb As Workbook, Optional ModuleName As String = "TableDefs") As VBComponent
If wb Is Nothing Then Set wb = ActiveWorkbook
Dim Component As VBComponent
On Error Resume Next
Set Component = wb.VBProject.VBComponents(ModuleName)
On Error GoTo 0
If Component Is Nothing Then
Set Component = wb.VBProject.VBComponents.Add(vbext_ComponentType.vbext_ct_StdModule)
Component.Name = ModuleName
End If
Set TableDefVBComponent = Component
End Function
uj5u.com熱心網友回復：
此函式將表回傳為 ListObject 指定或不指定作業簿
Function GetTableLO(tableName As String, Optional wb As Workbook = Nothing) As ListObject
On Error GoTo EH
Set GetTableLO = Nothing
If wb Is Nothing Then 'ActiveWorkbook assumed
Set GetTableLO = Range(tableName).ListObject
Else
Set GetTableLO = Evaluate("'" & wb.Name & "'!" & tableName).ListObject
End If
EH:
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/ruanti/514474.html