Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Abfrage ob Tabellenobjekt besteht

Betrifft: Abfrage ob Tabellenobjekt besteht von: Marcel
Geschrieben am: 23.03.2016 13:28:13

Mahlzeit :)

Habe ein Makro das voll funktioniert.
Es ermittelt die Tabelle und legt eine Tabelle an.

Problem, Dateien die bereits eine Tabelle enthalten wirft er mir als Fehler aus und bricht ab...Wie kann ich hier eine Plausibilität einbauen, sodass er bei bereits bestehenden Tabellen zur nächsten Datei weiter geht?

Vielen Dank.

Sub MWMultiDateiUpdateTEST()

Dim oSourceBook As Object
Dim strPfad As String
Dim strDatei As String
Dim lngLetzteZeile As Long
Dim lngLetzteSpalte As Long
Dim BrowseDir As Variant
Dim AppShell As Object
Dim ws As Worksheet
Dim lstList As ListObject
    
    
    
    Application.ScreenUpdating = False 'Das "Flackern" ausstellen

    MsgBox "Bitte wählen Sie den Ordner aus, in dem sich die Excel-Dateien befinden."

    'Schritt 1: Schleife über alle Excel Dateien in einem Verzeichnis
    Set AppShell = CreateObject("Shell.Application")
    Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
    On Error Resume Next
    strPfad = BrowseDir.items().Item().Path
    If strPfad = "" Then Exit Sub
    On Error GoTo 0
    strDatei = Dir(strPfad & "\*.xl*") 'Alle Excel Dateien
    
    Do While strDatei <> ""
      
    'Schritt 2: öffnen der Datei und Datenübertragung
    Set oSourceBook = Workbooks.Open(strPfad & "\" & strDatei, False, False) 'nur 
    lesend öffnen
    'Set oSourceBook = Workbooks.Open(strPfad & strDatei)
          
    'Änderungen durchführen
                                
    'Ermittle erste Zeile und letzte Spalte
    lngLetzteZeile = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
    lngLetzteSpalte = Sheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column

    'Bereich markieren
    Sheets(1).UsedRange.Select
    

    'Schleife für Plausibilität einbauen - funktioniert NICHT
    Set ws = ActiveSheet
    
    For Each lstList In ws.ListObjects
        If lstList.Name = "Tabelle1" Then        
            Exit For
        End If
        If lstList <> "Tabelle1" Then
            MsgBox "Es gibt keine Liste"
            Set lstList = Sheets(1).ListObjects.Add(xlSrcRange, Sheets 
            (1).UsedRange, , xlYes). _
            Name = _
            "Tabelle1"
            Exit For
        End If
    Next
    
    'Ab hier geht der Code wieder.

    'Kommando um Tabelle aufzulösen
    'Set Sheets(1).UsedRange.Select = Sheets(1).ListObjects("Tabelle1").Unlist
        
    'Tabelle erstellen
    'Set Sheets(1).UsedRange.Select = Sheets(1).ListObjects.Add(xlSrcRange, Sheets(1).UsedRange, _
 _
 , xlYes).Name = _
    "Tabelle1"

    'Unternehmensorange auf Tabelle anwenden
    'Sheets(1).ListObjects("Tabelle1").TableStyle = "TableStyleMedium3"
       
    'Spalten markieren und an Inhalt anpassen
    Columns("A:A").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Columns.EntireColumn.AutoFit
          
    'Schritt 3: Datei speichern und wieder zu machen und nächste Schleifenrunde
    Application.DisplayAlerts = False
    oSourceBook.Close True 'speichern
    Application.DisplayAlerts = True
          
    'Nächste Datei
    strDatei = Dir()
    
    Loop
      
    Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder   
    einschalten

    'Variablen aufräumen
    Set oSourceBook = Nothing
      
    MsgBox "Alle Dateien wurden erfolgreich bearbeitet."
    
End Sub

  

Betrifft: AW: Abfrage ob Tabellenobjekt besteht von: fcs
Geschrieben am: 23.03.2016 14:30:57

Hallo Marcel,

man kann "einfach" prüfen ob die Anzahl der Listobjekte = 0 ist.
Select-Anweisungen kann man meist vermeiden - sie fördern auch das Bildschirmflackern und erhöhen die Makro-Laufzeit.

Eine Fehlerbehandlung sollte so aufgebaut sein, dass man Fehlerhinweise bekommt und nicht einfach Fehler ignorieren.

Gruß
Franz


https://www.herber.de/bbs/user/104563.txt


 

Beiträge aus den Excel-Beispielen zum Thema "Abfrage ob Tabellenobjekt besteht"