Microsoft Excel

Herbers Excel/VBA-Archiv

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

Mehrere Tabellenblätter ansprechen


Betrifft: Mehrere Tabellenblätter ansprechen von: Kulo
Geschrieben am: 31.01.2018 00:25:45

Hallo Zusammen,

ich bastle mir gerade eine Tabelle zusammen und bin schon wieder an meine Grenzen gestoßen.

Mein Markro sucht aus einem Tabellenblatt einige Felder aus und trägt sie in ein anderes Tabellenblatt als Liste ein. Das klappt auch sehr gut.

Jetzt möchte ich jedoch das Makro so erweitern, dass es in allen relevanten Tabellenblättern sucht. Das könnten bis an die 80 werden.
Alle relevanten Tabellenblätter haben den gleichen Aufbau. Der Name des Tabellenblattes ist immer eine vierstellige Zahl.
Wenn ich eine Schleife von 1000 bis 9999 laufen lasse, dauert mir das zu lang.
Mit dem Blattindex möchte ich nicht arbeiten, weil ich weitere Tabellen hinzufügen möchte.
Eine Liste aller angefertigten Tabellenblätter befindet sich ebenfalls auf einem Tabellenblatt in der Arbeitsmappe. Kann man da was ableiten, mit einem Array vielleicht?

Ich würde mich freuen, wenn mir jemand auf die Sprünge helfen könnte.

Hier mein Code:

Sub Seriendruck()
Dim last As Integer

Application.ScreenUpdating = False

    For i = 2 To Worksheets("3036").Cells(3, Columns.Count).End(xlToLeft).Column - 1 Step 2
          
        If Worksheets("3036").Cells(Range("GZ").Row + 2, i).Value > 0 Then

            last = Worksheets("ListeDB").Cells(Rows.Count, 1).End(xlUp).Row + 1
            
            With Worksheets("ListeDB")
            
                .Cells(last, 1) = Worksheets("3036").Range("Name").Value
                .Cells(last, 2) = DateSerial(Worksheets("3036").Range("Jahr").Value, 1, 1)
                .Cells(last, 3) = DateSerial(Worksheets("3036").Range("Jahr").Value, 12, 31)
                .Cells(last, 4) = Worksheets("3036").Cells(Range("Land").Row, i).Value
                .Cells(last, 5) = Worksheets("3036").Cells(Range("GZ").Row, i + 1).Value
                .Cells(last, 6) = Worksheets("3036").Cells(Range("GZ").Row, i).Value
                .Cells(last, 7) = Worksheets("3036").Cells(Range("GZ").Row + 2, i).Value
                
            End With
        
        End If
        
    Next
    
Worksheets("3036").Activate
    
Application.ScreenUpdating = True

End Sub
Und kann man in der With-Anweisung was machen? Das sieht ja echt schlimm aus.

Ich freue mich auf eure Tipps und vielen Dank im Voraus.

Viele Grüße
Kulo

  

Betrifft: AW: Mehrere Tabellenblätter ansprechen von: Sepp
Geschrieben am: 31.01.2018 08:16:49

Hallo Kulo,

Sub Seriendruck()
Dim objSH As Worksheet
Dim lngLast As Integer, lngIndex As Long

On Error GoTo ErrorHandler

With Application
  .ScreenUpdating = False
  .EnableEvents = False
  .Calculation = xlCalculationManual
End With

For Each objSH In ThisWorkbook.Worksheets
  If objSH.Name Like "####" Then
    For lngIndex = 2 To objSH.Cells(3, Columns.Count).End(xlToLeft).Column - 1 Step 2
      If objSH.Cells(Range("GZ").Row + 2, lngIndex).Value > 0 Then
        lngLast = Worksheets("ListeDB").Cells(Rows.Count, 1).End(xlUp).Row + 1
        With Worksheets("ListeDB")
          .Cells(lngLast, 1) = objSH.Range("Name").Value
          .Cells(lngLast, 2) = DateSerial(objSH.Range("Jahr").Value, 1, 1)
          .Cells(lngLast, 3) = DateSerial(objSH.Range("Jahr").Value, 12, 31)
          .Cells(lngLast, 4) = objSH.Cells(Range("Land").Row, lngIndex).Value
          .Cells(lngLast, 5) = objSH.Cells(Range("GZ").Row, lngIndex + 1).Value
          .Cells(lngLast, 6) = objSH.Cells(Range("GZ").Row, lngIndex).Value
          .Cells(lngLast, 7) = objSH.Cells(Range("GZ").Row + 2, lngIndex).Value
        End With
      End If
    Next
  End If
Next

ErrorHandler:

If Err.Number <> 0 Then
  MsgBox "Fehler in Modul1" & vbLf & vbLf & "Prozedur:" & vbTab & "Seriendruck" & vbLf & _
    "Nummer:" & vbTab & Err.Number & vbLf & "Meldung:" & vbTab & Err.Description & vbLf & _
    IIf(Erl, "Zeile:" & vbTab & Erl, ""), vbExclamation, "Fehler!"
  Err.Clear
End If

With Application
  .ScreenUpdating = True
  .EnableEvents = True
  .Calculation = xlCalculationAutomatic
End With

End Sub


Gruß Sepp



  

Betrifft: Problem gelöst, Nachfrage von: Kulo
Geschrieben am: 31.01.2018 08:56:49

Hallo Sepp, guten Morgen,

vielen vielen Dank.
Heute früh bei der ersten Tasse Kaffe kam mir das mit dem "For Each" und "like" auch in den Sinn. Hätte aber wahrscheinlich rumprobieren müssen, ehe es laufen würde. Das mit dem "like" habe ich erst vor kurzem gelesen und noch nie ausprobiert.
Jetzt hab ich wieder was gelernt.

Leider verstehe ich nicht so recht, warum es besser ist, EnableEvents auf False zu setzen und Calculation auf manuell. Was bewirkt dieses? Welche Konsequenzen hat es, wenn man das wegläßt.

Ich würde mich sehr freuen, wenn Du nochmal kurz auf diese Sache eingehen könntest.

Vielen Dank nochmal und
viele Grüße
Kulo
Und wie machst Du Deinen Code bunt?


  

Betrifft: AW: Problem gelöst, Nachfrage von: Sepp
Geschrieben am: 31.01.2018 09:10:36

Hallo Kulo,

in Arbeitsmappen befinden sich ja meist irgendwo Formeln, und wenn durch den Code Zellen beschrieben werden, auf die eine solche Formel Bezug nimmt, wird bei jeder Änderung eine Neuberechnung ausgeführt. Bei manchen Funktionen (z.B. INDIREKT() oder JETZT()), braucht wird immer neu Berechnet, auch wenn keine geänderte Zelle direkt betroffen ist. Das kann einen Code ziemlich ausbremsen.
Deshalb die Berechnung auf manuell stellen und am Ende wieder auf automatisch.

Das selbe gilt für .EnableEvents. Viele Tabellen enthalten Code der auf Änderungen reagiert, diese würden nun bei jedem Durchlauf evtl. mehrfach ausgelöst.

Also liebe zu Begin ausschalten und am Ende wieder aktivieren, schadet nicht wenn es umsonst ist, bringt aber viel wenn solcher Code vorhanden ist.

Gruß Sepp



  

Betrifft: AW: Problem gelöst, Nachfrage von: Kulo
Geschrieben am: 31.01.2018 18:07:24

Hallo Sepp,

vielen Dank für Deine Erklärung.
Jetzt kann ich das Ganze nachvollziehen.

Du hast mir wirklich sehr geholfen.

Viele Grüße und bis zum nächsten Mal, wenn ich darf. ;-)

Kulo


Beiträge aus dem Excel-Forum zum Thema "Mehrere Tabellenblätter ansprechen"