Sheet per VBA löschen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Sheet per VBA löschen
von: worm77
Geschrieben am: 25.08.2015 09:53:38

Hallo zusammen
Ich habe ein VBA-Makro erstellt, das Daten zusammen sucht und dann ein Diagramm erstellt.
Das Diagramm soll in ein neues Sheet gestellt werden, das CHART heisst.
Nun wird eben das Exel-Sheet immer gespeichert, um die historischen Daten zu behalten.
Ich habe dann im VBA folgende Zeile eingefügt, die das Sheet CHART löschen soll, bevor das neue Diagramm erstellt wird:
Worksheets("CHART").Delete
Nur leider wird das Sheet CHART nicht gelöscht... Das neue Diagramm wird dann im Sheet erstellt, wo die Daten her sind.
Weiss jemand, woran das liegen könnte?
Bin euch für eure Hilfe sehr dankbar!
Gruss Rolf

Bild

Betrifft: AW: Sheet per VBA löschen
von: Rudi Maintaire
Geschrieben am: 25.08.2015 10:01:22
Hallo,
Weiss jemand, woran das liegen könnte?
an deinem Code, woran sonst?
Gruß
Rudi

Bild

Betrifft: AW: Sheet per VBA löschen
von: worm77
Geschrieben am: 25.08.2015 10:13:09
Hahaha ... toller Beitrag.

Bild

Betrifft: Glaskugel defekt. owT
von: Rudi Maintaire
Geschrieben am: 25.08.2015 10:15:06


Bild

Betrifft: AW: Sheet per VBA löschen
von: Dieter(Drummer)
Geschrieben am: 25.08.2015 10:24:51
Hi Rolf,
wenn Du den ganzen Code nicht zeigst, wird auch kaum jemand helfen können.
Eine Vermutung von mir, dass das CHART auch ein Zahl hat, z.B. "CHART1" ...
Sonst kann ich nicht weiter helfen.
Gruß, Dieter(Drummer)

Bild

Betrifft: AW: Sheet per VBA löschen
von: Gerd L
Geschrieben am: 25.08.2015 10:34:49
Hallo Rolf!
Welche Fehlermeldung erhältst du, wenn das Löschen des Blattes scheitert?
Gruß Gerd

Bild

Betrifft: AW: Sheet per VBA löschen
von: worm77
Geschrieben am: 25.08.2015 10:55:15
Hallo zusammen
Ich erhalte leider gar keine Fehlermeldung...
Hab jetzt auch in nem Forum gesehen, dass man Warnmeldungen ausschalten soll, was ich auch versucht habe... aber mit dem gleichen Ergebnis.
Das Diagramm wird einfach im Sheet Masterdata erstellt.
Hier das Daten-File: https://www.herber.de/bbs/user/99814.xlsx
Hier der gesamte Code:


On Local Error Resume Next
' getsource Makro
'
    Dim Auswahl, RetVal
    Dim LastRow, NewRow As Long
    Dim Zelle As Range
    
    InputDrive = ThisWorkbook.Sheets("Mastertable").Range("E16").Value
    InputDirectory = ThisWorkbook.Sheets("Mastertable").Range("E17").Value
    
    ChDrive InputDrive
    ChDir InputDirectory
    
    ThisWorkbook.Sheets("Mastertable").Range("E30").Value = Replace(CStr(Time()), ":", "")
    Calculate
    
    ArchiveDrive = ThisWorkbook.Sheets("Mastertable").Range("E19").Value
    ArchiveDirectory = ThisWorkbook.Sheets("Mastertable").Range("E20").Value
    StatsDrive = ThisWorkbook.Sheets("Mastertable").Range("E22").Value
    StatsDirectory = ThisWorkbook.Sheets("Mastertable").Range("E23").Value
    StatsName = ThisWorkbook.Sheets("Mastertable").Range("E24").Value
    
    
    
    
' Prüfen, ob Input-Folder leer ist. Wenn leer, dann Makro abbrechen
    If Dir$(InputDrive & ":\" & InputDirectory & "\*.*") = vbNullString Then
    
       RetVal = MsgBox("Input-Verzeichnis ist leer!" & vbCrLf & vbCrLf & "Verarbeitung  _
abgebrochen!", vbCritical, "Keine Daten vorhanden!")
    
       Exit Sub
       
    End If
    
    
'Basis-File öffnen
    
Application.Run "KRun_Statistik.xlsm!getbasis"
Windows("KRun_Statistik_Basis.xlsx").Activate
    
' Importiere alle Files in Input-Folder
ChDrive InputDrive
ChDir InputDirectory
Dim lngR As Long
Dim strFile As String, strTabName As String
strFile = Dir(InputDrive & ":\" & InputDirectory & "\" & "*.txt")
lngR = 1
With ActiveWorkbook.Sheets("TEMP")
.Range("A2:B" & Rows.Count).ClearContents
    
Do Until strFile = ""
lngR = lngR + 1
        ActiveWorkbook.Sheets("TEMP").Cells.Clear
        Sheets("TEMP").Select
        With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & strFile, Destination:=Range("$A$ _
1"))
            .Name = "file"
            .FieldNames = False
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 2
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(4, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
        
      Dim Bereich As Range
  
      For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile
          If Range("C" & x).Value = "Start" And Range("C" & x + 1).Value = "Stop" Then
              Range("E" & x & ":H" & x).Value = Range("A" & x + 1 & ":D" & x + 1).Value
              Range("A" & x + 1).Value = "löschen"
          End If
      Next x
  
      Do
          Set Bereich = Range("A:A").Find(What:="löschen", LookIn:=xlFormulas, _
                  LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                  MatchCase:=False, SearchFormat:=False)
              If Bereich Is Nothing Then
              Exit Do
           Else: Rows(Bereich.Row).Delete Shift:=xlUp
          End If
      Loop
' Berechnung Runtime einfügen
        Range("A1:H1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Auswahl = Selection.Address
    
        LastRow = Selection.Row + Selection.Rows.Count - 1
    
        With Range("I1:I" & LastRow)
             .Formula = "=F1-B1"
        End With
' Daten in MASTERDATA übertragen
        Range("A1:I1").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
    
        Sheets("MASTERDATA").Select
        Range("A1").Select
        Range(Selection, Selection.End(xlDown)).Select
    
        NewRow = Selection.Rows.Count + 1
    
        If NewRow > 1000000 Then
           NewRow = 2
        End If
    
        Range("A" & NewRow).Select
        ActiveSheet.Paste
        
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        fso.MoveFile strFile, ArchiveDrive & ":\" & ArchiveDirectory & "\"
        
        
    
        strFile = Dir
    Loop
    
End With
' Daten kopieren für CHART
    Range("A1:I1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Auswahl = Selection.Address
    
    LastRow = Selection.Row + Selection.Rows.Count - 1
    
    With Range("N1:N" & LastRow)
         .Formula = "=A1"
    End With
    With Range("O1:O" & LastRow)
         .Formula = "=D1"
    End With
    With Range("P2:P" & LastRow)
         .Formula = "=CONCATENATE(TEXT(N2,""tt.MM.jjjj""),"" "",O2)"            ' <<<<-------"
    End With
    With Range("Q1:Q" & LastRow)
         .Formula = "=I1"
    End With
  
' Sortiere die Daten absteigend nach Grösse
    ActiveWorkbook.Worksheets("MASTERDATA").Cells.Select
    Range("A1:Q1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Auswahl = Selection.Address
    
    LastRow = Selection.Row + Selection.Rows.Count - 1
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("MASTERDATA").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("MASTERDATA").Sort.SortFields.Add Key:=Range( _
        "A2:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("MASTERDATA").Sort.SortFields.Add Key:=Range( _
        "I2:I" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("MASTERDATA").Sort
        .SetRange Range("A1:I" & LastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-18
    
' richtige Formatierung setzen
    Range("A:A,E:E,N:N").Select
    Selection.NumberFormat = "dd/mm/yyyy;@"
    
    Range("B:B,F:F,I:I,P:P").Select
    Selection.NumberFormat = "hh:mm:ss;@"
    
    
' Doppelte Zeilen löschen
    
    Range("A1:Q" & LastRow).Select
    Range(Selection, Selection.End(xlToRight)).Select
    ActiveSheet.Range("$A$1:$Q$" & LastRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
        7, 8, 9), Header:=xlYes
   
       
' CHART erstellen
    Range("A1:Q1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Auswahl = Selection.Address
    
    LastRow = Selection.Row + Selection.Rows.Count - 1
    Application.DisplayAlerts = False
    Worksheets("CHART").Delete
    Application.DisplayAlerts = True
    
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlLine
    ActiveChart.SetSourceData Source:=Range("MASTERDATA!$P$1:$Q$" & LastRow)
    ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="CHART"
    ActiveChart.ClearToMatchStyle
    ActiveChart.ChartStyle = 4
    ActiveChart.ClearToMatchStyle
    
    Range(LastRow + 1).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.EntireRow.Delete
    
    Range("R1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.EntireColumn.Delete
    Range("A2").Select
    
    
' Speichern von Basis-File und sichern unter Stats
    Windows("KRun_Statistik_Basis.xlsx").Activate
    ActiveWorkbook.Save
    ActiveWorkbook.SaveAs Filename:=StatsDrive & ":\" & StatsDirectory & "\" & StatsName & ". _
xlsx"
    ThisWorkbook.Save
    ThisWorkbook.Close


Bild

Betrifft: AW: Sheet per VBA löschen
von: Rudi Maintaire
Geschrieben am: 25.08.2015 11:11:38
Hallo,
wie schon erwähnt: CHART ist kein Worksheet, sondern ein Chart.
Charts("Chart").Delete
Das hat man vom Einsatz von On Error...
Gruß
Rudi

Bild

Betrifft: AW: Sheet per VBA löschen
von: worm77
Geschrieben am: 25.08.2015 11:33:42
Super!
Vielen herzlichen Dank!
Hat bestens funktioniert!
Jetzt muss ich nur noch herausfinden, wieso das File mit jeder Ausführung extrem viel grösser und sehr langsam wird.
Gruss Rolf

Bild

Betrifft: AW: Sheet per VBA löschen
von: selli
Geschrieben am: 25.08.2015 13:07:48
hallo rolf,
Jetzt muss ich nur noch herausfinden, wieso das File mit jeder Ausführung extrem viel grösser und sehr langsam wird.
du solltest mal überlegen, dass du bei jedem mal wenn dein code läuft, eine abfrage eingefügt wird.
die bleiben natürlich erhalten solange sie nicht gelöscht werden.
wie oft hast du den code denn schon ausgeführt?
gruß
selli

Bild

Betrifft: AW: Sheet per VBA löschen
von: worm77
Geschrieben am: 25.08.2015 14:02:45
Hallo Selli
Nun, während dem "Programmieren" führe ich das natürlich zich mal aus.
Ging so weit, dass gar nichts mehr ging... Also das File gar nicht mehr verwendet werden konnte ("Excel reagiert nicht").
Kannst du mir da vielleicht sagen, wie ich diese Abfragen löschen kann?
Am besten natürlich per VBA :-)
Vielen herzlichen Dank schon mal im Voraus.
Gruss Rolf

Bild

Betrifft: AW: Sheet per VBA löschen
von: selli
Geschrieben am: 25.08.2015 14:12:03
hallo rolf,
....QueryTable.Delete
gruß
selli

Bild

Betrifft: AW: Sheet per VBA löschen
von: worm77
Geschrieben am: 25.08.2015 15:25:22
Hoi Selli
Hab's jetzt mal so gemacht:
Dim qt As QueryTable
Dim WSh As Worksheet
For Each WSh In ThisWorkbook.Worksheets
For Each qt In WSh.QueryTables
qt.ResultRange.ClearContents
qt.Delete
Next qt
Next WSh
Nun, das File wird jetzt pro Ausführungen nur noch 2kb grösser (obwohl die genau gleichen Daten eingelesen werden) ...
Dies würde mich ja nicht weiter stören...
Aber mit jeder Ausführung braucht's ca. doppelt so lang, bis das File geöffnet wird.
Irgendwo muss da noch was im Hintergrund sein, was nicht passt...
Hab in den Dokument-Eigenschaften gesehen, dass da für das Blatt MASTERDATA über 600 Files angezeigt werden...
Userbild
Kann es vielleicht daran liegen und wie könnte ich das dann beheben?
Die Auswertung muss einmal pro Woche gemacht werden und dabei werden Dateien von 20 Servern abgeholt und importiert... Also müsste ich schon eine Lösung haben, dass es nicht immer länger dauert. :-)
Besten Dank und
Gruss Rolf

Bild

Betrifft: AW: Sheet per VBA löschen
von: Rudi Maintaire
Geschrieben am: 25.08.2015 15:32:56
Hallo,
das sind Namen!
Wahrscheinlich kannst du sie löschen.
Gruß
Rudi

Bild

Betrifft: oder...
von: selli
Geschrieben am: 25.08.2015 16:02:03
hallo rolf,
...es könnten auch die 600 abfragen sein, die du bislang angelegt aber nicht wieder gelöscht hast.
gruß
selli

Bild

Betrifft: noch die Verbindungen köschen.
von: Rudi Maintaire
Geschrieben am: 25.08.2015 16:15:59
dann wird's gleich schneller.

  For Each c In ActiveWorkbook.Connections
  c.Delete
  Next

Gruß
Rudi

Bild

Betrifft: =ERSETZEN("köschen";1;1;"l") owT
von: Rudi Maintaire
Geschrieben am: 25.08.2015 16:18:18


Bild

Betrifft: AW: =ERSETZEN("köschen";1;1;"l") owT
von: worm77
Geschrieben am: 25.08.2015 16:33:47
Hoi Rudi
Super! Vielen herzlichen Dank!
Hatte schon fast 900 Connections...
Jetzt öffnet es sich bedeutend schneller.
Gruss Rolf

Bild

Betrifft: Schuss ins Blaue
von: RPP63
Geschrieben am: 25.08.2015 10:44:45
Hi!
Handelt es sich wirklich um ein Worksheet?
Wenn es ein Diagramm-Blatt ist, dann
Sheets("Chart").Delete
(die Groß- Kleinschreibung im String ist irrelevant)
Gruß Ralf

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Sheet per VBA löschen"