Dieses Makro über mehrere Tabellen

Sub LOAsumiert022() Dim summe As Single, bereich As range, zelle As range, wsszelle, j As Date j = Now n = 6 'Zeilenzähler für Pers-Nr. in SozialplanSumme Tabelle d = 3 'Spaltenzähler für LOA summe = 0 Set wss = ThisWorkbook.Worksheets("SozialplanSumme") Set w022 = ThisWorkbook.Worksheets("Mandant022") wsszelle = wss.UsedRange.Rows.Count + 1 w022zelle = w022.UsedRange.Rows.Count wssSpalte = wss.UsedRange.Columns.Count w022bereich = range(Cells(1, 1), Cells(w022zelle, 1)).Address Set bereich = w022.range(w022bereich) Do Until d = wssSpalte Do Until n = wsszelle + 1 For Each zelle In bereich If zelle.Value = wss.range("A" & n).Value And _ zelle.Offset(0, 9) = wss.Cells(2, d) Then summe = summe + zelle.Offset(0, 11).Value Else End If Next zelle wss.Cells(n, d) = summe n = n + 1 summe = 0 Loop d = d + 1 n = 6 Loop Debug.Print "LOAsummiert022-Makro abgearbeitet in: " & Format(Now - j, "hh:mm:ss") End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Uwe,

ich nehme mal an, das die Tabellenblätter die übertragen
werden sollen alle den Namen "Mandantxxx" haben.

Dann arbeitet die zusätzliche Schleife alle Blätter
ab deren Name mit "Mandant" beginnt.

Sub LOAsumiert022()

Dim summe As Single, bereich As Range, zelle As Range, wsszelle, j As Date
Dim wks As Worksheet
j = Now
n = 6       'Zeilenzähler für Pers-Nr. in SozialplanSumme Tabelle
d = 3       'Spaltenzähler für LOA
summe = 0
Set wss = ThisWorkbook.Worksheets("SozialplanSumme")
For Each wks In ThisWorkbook.Sheets
If Left(wks.Name, 7) = "Mandant" Then  'Überprüft den Namen der Tabelle
Set w022 = wks    'Wenn Tabellenname mit "Mandant" beginnt dann

wsszelle = wss.UsedRange.Rows.Count + 1
w022zelle = w022.UsedRange.Rows.Count
wssSpalte = wss.UsedRange.Columns.Count

w022bereich = Range(Cells(1, 1), Cells(w022zelle, 1)).Address
Set bereich = w022.Range(w022bereich)
Do Until d = wssSpalte
    Do Until n = wsszelle + 1
        For Each zelle In bereich
            If zelle.Value = wss.Range("A" & n).Value And _
                zelle.Offset(0, 9) = wss.Cells(2, d) Then
                summe = summe + zelle.Offset(0, 11).Value
                Else
            End If
        Next zelle
        wss.Cells(n, d) = summe
        n = n + 1
        summe = 0
    Loop
    d = d + 1
    n = 6
Loop
Next  'Schleife für alle Tabellen
Debug.Print "LOAsummiert022-Makro abgearbeitet in: " & Format(Now - j, "hh:mm:ss")
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruß Sepp

Sub Workbook_Summiertes_022() 'by Ramses 'Variablendeklaration Dim summe As Single, i As Integer, n As Long, d As Long Dim wksZelle As Long, wssZelle As Long, wssSpalte As Integer Dim wksBereich As Range, Bereich As Range, Zelle As Range Dim j As Date 'w022 wurde durch wks ersetzt um für alle Worksheets 'angewendet werden zu können Dim wss As Worksheet, wks As Worksheet 'Variablenzuweisung j = Now n = 6 'Zeilenzähler für Pers-Nr. in SozialplanSumme Tabelle d = 3 'Spaltenzähler für LOA summe = 0 Set wss = ThisWorkbook.Worksheets("SozialplanSumme") 'Start der Schleife über alle Tabellen in 'der aktuellen Arbeitsmappe For i = 1 To Worksheets.Count Set wks = Worksheets(i).Name 'Tabellenname muss mit "Mandant" beginnen If UCase(Left(wks, 7)) <> "MANDANT" Then Debug.Print "Makro " & i & " von " & Worksheets.Count & _ " für " & wks & " gestartet um: " & Format(Now - j, "hh:mm:ss") 'Hier wurden keine Änderungen mehr vorgenommen wssZelle = wss.UsedRange.Rows.Count + 1 wksZelle = wks.UsedRange.Rows.Count wssSpalte = wss.UsedRange.Columns.Count wksBereich = wks.Range(Cells(1, 1), wks.Cells(wksZelle, 1)).Address Set Bereich = wks.Range(wksBereich) Do Until d = wssSpalte Do Until n = wssZelle + 1 For Each Zelle In Bereich If Zelle.Value = wss.Range("A" & n).Value And _ Zelle.Offset(0, 9) = wss.Cells(2, d) Then summe = summe + Zelle.Offset(0, 11).Value End If Next Zelle wss.Cells(n, d) = summe n = n + 1 summe = 0 Loop d = d + 1 n = 6 Loop Debug.Print "Makro " & i & " fertig um: " & Format(Now - j, "hh:mm:ss") End If Next i End Sub

Hallo Uwe

ich hab mal versucht die Tabelle nachzubilden.
Mit nachfolgendem Code läuft es zumindest bei mir:

Sub Workbook_Summiertes_022()
'by Ramses
'Variablendeklaration
Dim summe As Single, i As Integer, n As Long, d As Long
Dim wksZelle As Long, wssZelle As Long, wssSpalte As Integer
Dim wksBereich As String, Bereich As Range, Zelle As Range
Dim j As Date
'w022 wurde durch wks ersetzt um für alle Worksheets
'angewendet werden zu können
Dim wss As Worksheet, wks As Worksheet
'Variablenzuweisung
j = Now
n = 6       'Zeilenzähler für Pers-Nr. in SozialplanSumme Tabelle
d = 3       'Spaltenzähler für LOA
summe = 0
Set wss = ThisWorkbook.Worksheets("SozialplanSumme")
'Start der Schleife über alle Tabellen in
'der aktuellen Arbeitsmappe
For i = 1 To Worksheets.Count
    Set wks = ThisWorkbook.Worksheets(Worksheets(i).Name)
    'Tabellenname muss mit "Mandant" beginnen
    If UCase(Left(wks.Name, 7)) <> "MANDANT" Then
        Debug.Print "Makro " & i & " von " & Worksheets.Count & _
            " für " & wks.Name & " gestartet um: " & Format(Now - j, "hh:mm:ss")
        'Hier wurden keine Änderungen mehr vorgenommen
        wssZelle = wss.UsedRange.Rows.Count + 1
        wksZelle = wks.UsedRange.Rows.Count
        wssSpalte = wss.UsedRange.Columns.Count
        wksBereich = Range(Cells(1, 1), Cells(wksZelle, 1)).Address
        Set Bereich = wks.Range(wksBereich)
        Do Until d = wssSpalte
            Do Until n = wssZelle + 1
                For Each Zelle In Bereich
                    If Zelle.Value = wss.Range("A" & n).Value And _
                        Zelle.Offset(0, 9) = wss.Cells(2, d) Then
                        summe = summe + Zelle.Offset(0, 11).Value
                    End If
                Next Zelle
                wss.Cells(n, d) = summe
                n = n + 1
                summe = 0
            Loop
        d = d + 1
        n = 6
        Loop
        Debug.Print "Makro " & i & " fertig um: " & Format(Now - j, "hh:mm:ss")
    End If
Next i
End Sub

Code eingefügt mit Syntaxhighlighter 1.16

Gruss Rainer

Beliebteste Forumthreads (12 Monate)

Dieses Makro über mehrere Tabellen

31 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

31
Beiträge zum Forumthread

Beiträge zu diesem Forumthread