Excel VBA Table Object, Bereiche und Funktionen
Ein Table Object ist ein strukturierter Bereich. Auf die einzelnen Bereiche / Sektionen kann über VBA Code referenziert werden. Table Objects können mit Dynamik umgehen (Zeilen und / oder Spalten hinzufügen oder löschen).
siehe auch Objekttypen Excel Power Query
Shortcut zur Erstellung eines Table Objects = STRG - T
Bereiche / Sektionen eines Table Objects
Beispiele VBA Funktionen im Umfeld von Table Object
VBA Code
--- SCHNIPP
Sub RemovePartsOfTable()
'Teile eines TableObjects löschen
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
'Entferne 3te Spalte
tbl.ListColumns(3).Delete
'entferne 4te Datenzeile
tbl.ListRows(4).Delete
'entferne 3te bis 5te Datenzeile
tbl.Range.Rows("3:5").Delete
'entferne Gesamtsumme
tbl.TotalsRowRange.Delete
End Sub
Sub ResetTable()
'Entferne die Datenzeilen in einem TableObject
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
'entferne alle Datenzeilen bis auf die erste
With tbl.DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
End If
End With
'Entferne Datenzeilen ab erster Zeile
tbl.DataBodyRange.Rows(1).ClearContents
End Sub
Sub ResetTable2()
'Entferne Werte, jedoch nicht Formeln in einem TableObject
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
'Entferne alle Datenzeilen bis auf die erste
With tbl.DataBodyRange
If .Rows.Count > 1 Then
.Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count).Rows.Delete
End If
End With
'entferne alle Datenzeilen, erhalte die Formeln
tbl.DataBodyRange.Rows(1).SpecialCells(xlCellTypeConstants).ClearContents
End Sub
Sub LoopingThroughTable()
'Durchlaufe alle Zeilen oder Spalten
Dim tbl As ListObject
Dim x As Long
Set tbl = ActiveSheet.ListObjects("Table1")
'Durchlaufe alle Spalten eines TableObjects
For x = 1 To tbl.ListColumns.Count
tbl.ListColumns(x).Range.ColumnWidth = 8
Next x
'Durchlaufe alle Zeilen eines TableObjects
For x = 1 To tbl.Range.Rows.Count
tbl.Range.Rows(x).RowHeight = 20
Next x
'Durchlaufe jede Datenzeile im TableObject
For x = 1 To tbl.ListRows.Count
tbl.ListRows(x).Range.RowHeight = 15
Next x
End Sub
Sub SingleColumnTable_To_Array()
'Lade Datenzeilen in einen Array
Dim myTable As ListObject
Dim myArray As Variant
Dim TempArray As Variant
Dim x As Long
'Bezug zu TableObject herstellen
Set myTable = ActiveSheet.ListObjects("Table1")
'Erstelle Array aus TableObject
TempArray = myTable.DataBodyRange
'Konvertiere von vertikale zu horizontalem Array
myArray = Application.Transpose(TempArray)
'Durchlaufe jedes Element im Array / Ausgabe im VBA Direktbereich
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x)
Next x
End Sub
Sub MultiColumnTable_To_Array()
Dim myTable As ListObject
Dim myArray As Variant
Dim x As Long
'Bezug zu TableObject herstellen
Set myTable = ActiveSheet.ListObjects("Table1")
'Erstelle Array aus TableObject
myArray = myTable.DataBodyRange
'Durchlaufe jedes Element in der dritten Spalte des TableObjects / Ausgabe im VBA Direktbereich
For x = LBound(myArray) To UBound(myArray)
Debug.Print myArray(x, 3)
Next x
End Sub
Sub ResizeTable()
'Redimiensionierung des TableObjects
Dim rng As Range
Dim tbl As ListObject
'Redimensioniere das TableObject zu 7 Zeilen und 5 Spalten
Set rng = Range("Table1[#All]").Resize(7, 5)
ActiveSheet.ListObjects("Table1").Resize rng
'Erweitere die Zeilenanzahl des TableObjects auf 10
Set tbl = ActiveSheet.ListObjects("Table1")
Set rng = Range("Table1[#All]").Resize(tbl.Range.Rows.Count + 10, tbl.Range.Columns.Count)
tbl.Resize rng
End Sub
Sub RemoveTableBodyData()
'Alle Datenzeilen des TableObjects entfernen
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects("Table1")
'Alle Datenzeilen entfernen
If tbl.ListRows.Count >= 1 Then
tbl.DataBodyRange.Delete
End If
End Sub
Sub ChangeAllColumnTotals()
'Alle Spalten Berechnungen / Aggragat funktionen ändern
Dim tbl As ListObject
Dim CalcType As Integer
Dim x As Long
Set tbl = ActiveSheet.ListObjects("Table1")
'Welche Berechnung / Aggragatfunktion soll auf die Spalte angewendet werden ?
CalcType = 1 'or: xlTotalsCalculationSum
'Durchlaufew alle Spalten des TableObjects
For x = 1 To tbl.ListColumns.Count
tbl.ListColumns(x).TotalsCalculation = CalcType
Next x
'___________________________________________
'Mitglieder von xlTotalsCalculation
'Enum Calculation
' 0 None
' 1 Sum
' 2 Average
' 3 Count
' 4 Count Numbers
' 5 Min
' 6 Max
' 7 Std Deviation
' 8 Var
' 9 Custom
'___________________________________________
End Sub
Sub DetermineActiveTable()
'Aktives TableObjekt ermitteln
Dim SelectedCell As Range
Dim TableName As String
Dim ActiveTable As ListObject
Set SelectedCell = ActiveCell
'Festellen ob aktive Zelle innerhalb TableObject
On Error GoTo NoTableSelected
TableName = SelectedCell.ListObject.Name
Set ActiveTable = ActiveSheet.ListObjects(TableName)
On Error GoTo 0
'Tu etwas mit Deiner TableObject Variable, zB eine Zeile anfügen
ActiveTable.ListRows.Add AlwaysInsert:=True
Exit Sub
'Fehlerbehandlung
NoTableSelected:
MsgBox "There is no Table currently selected!", vbCritical
End Sub
--- SCHNAPP ---
Kommentare
Kommentar veröffentlichen