Office: Monatsdatenspannen summieren

Hallöchen,

Excel 2002
VB 6

ich hab da eine Datei, die mir automatisch die Stunden des Aktuellen Monats für jeden Mitarbeiter gibt.
Könnt ihr mir Tips geben wie ich den Code umändern kann damit ich zu jedem Mitarbeiter die Summe der Stunden vom Januar bis zum aktuellen Monat erreiche?

Wäre es auch möglich es so einzurichten, dass hinten (am Ende der Stunden für alle Mitarbeiter stehen die Summen der Stunden) die Spalte bei der Summe nullist, rausgelöscht wird?
Ich habe das Problem dass die Summe immer auf einer anderen Spalte stehen kann, da es ja von den Mitarbeitern abhängig ist, und diese ja automatisch verändert werden sobalt ein neuer Mitarbeiter hinzukommt oder rausgenommen wird. In der Spalte nach der Summe steht allerdings auch noch etwas geschrieben.
Wie kann ich dem Computer sagen er soll die Spalte rauslesen wo nichts drinnen ist da dann zwei zurück gehen und kontrollieren ob dort eine null eingetragen wurde um diese Zeile dann zu löschen?

Ich stell mal den Code rein damit es etwas verständlicher ist, hoffe aber dass es nicht zu lang wird

Danke schon mal im vorraus

Code:

Dim currentColumn As Integer



Sub Schaltfläche1_BeiKlick()

    ' alte werte löschen
    Dim bereich As Range
    
    letzteZeile = LetzteMonatsübersichtZeile()
    
    Set bereich = Range("C7:F" & letzteZeile)
    bereich.ClearContents
    
    ' alle mitarbeiter löschen
    Set bereich = Range(Cells(6, 7), Cells(letzteZeile, LetzteNamenSpalte))
    bereich.ClearContents
    
    Set bereich = Nothing
    
    ' aktuelle Spalte für den Mitarbeiter
    currentColumn = 7
    
    ' Verzeichnis in dem die Nachweise sind
    nachweiseVerzeichnis = "C:\temp\CHRISTINE\Nachweise\"
    
    ' aktuelles Jahr
    currentYear = Year(Date)
    
    ' aktuelles Verzeichnis
    currentDir = nachweiseVerzeichnis & currentYear
    
    ' alle Dateien in dem Verzeichnis durchgehen
    dateiName = Dir(currentDir & "\*.xls") 'Ersten Eintrag abrufen
    Do While dateiName <> "" 'Schleife beginnen
        ' NN.xls ignorieren
        If dateiName <> "NN.xls" Then
            ' mitarbeiter mappe öffnen
            Workbooks.Open (currentDir & "\" & dateiName)
            
            ' Werte auslesen
            MitarbeiterXlsAuslesen (dateiName)
            
            'nächste Spalte
            currentColumn = currentColumn + 1
            
            ' Mitarbeiter mappe wieder schliessen
            ActiveWorkbook.Close
            
        End If
        dateiName = Dir
    Loop 'Schleife beenden
    
    'Summe hinzufügen
    Summeerstellen
    
    
End Sub

Sub MitarbeiterXlsAuslesen(ByVal dateiName As String)
    With Tabelle1
    
    ' Überschrift hinzufügen
    .Cells(6, currentColumn).Value = Left$(dateiName, Len(dateiName) - 4)
    
    currentMonth = Month(Date)
    Dim curentMonthSheet As Workbook
    
    ' die mappe für den aktuellen monat finden
    For i = 1 To ActiveWorkbook.Sheets.Count
        sheetName = ActiveWorkbook.Sheets(i).Name
        If Val(sheetName) = currentMonth Then
            Set currentMonthSheet = ActiveWorkbook.Sheets(i)
            Exit For
        End If
    Next i
    
    ' Zeile für Zeile durchgehen
    For currentRow = 5 To 78
        
        With currentMonthSheet
        
        ' KST überprüfen (Spalte 40)
        Dim wert As Integer
        Dim kst As String
                
        If .Cells(currentRow, 40) <> "" Then
            kst = .Cells(currentRow, 40)
            wert = .Cells(currentRow, 44)
            AddKST kst, wert
        End If
        
        ' Auftrag überprüfen (Spalte 41)
        Dim auftrag As String
                
        If .Cells(currentRow, 41) <> "" Then
            auftrag = .Cells(currentRow, 41)
            wert = .Cells(currentRow, 44)
            AddAuftrag auftrag, wert
        End If
        
        
        ' NetzplanVrg überprüfen (Spalte 42/43)
        Dim netzplan As String
        Dim vrg As String
                
        If .Cells(currentRow, 42) <Then> neuen eintrag erzeuegen
        If kstRow = 0 Then
            kstRow = LetzteMonatsübersichtZeile()
            .Cells(kstRow, 3).Value = kst
            .Cells(kstRow, currentColumn).Value = wert
        Else
            Dim alterWert As Integer
            alterWert = .Cells(kstRow, currentColumn).Value
            .Cells(kstRow, currentColumn).Value = alterWert + wert
        End If

    End With
End Sub

Sub AddAuftrag(ByVal auftrag As String, ByVal wert As Integer)
    Dim auftragRow As Integer
    auftragRow = 0
    With Tabelle1
        ' suchen des auftrags unter bereits eingetragenen
        For currentRow = 7 To LetzteMonatsübersichtZeile()
            If .Cells(currentRow, 4).Value = auftrag Then
                auftragRow = currentRow
                Exit For
            End If
        Next currentRow
        ' nichts gefunden -> neuen eintrag erzeuegen
        If auftragRow = 0 Then
            auftragRow = LetzteMonatsübersichtZeile()
            .Cells(auftragRow, 4).Value = auftrag
            .Cells(auftragRow, currentColumn).Value = wert
        Else
            Dim alterWert As Integer
            alterWert = .Cells(auftragRow, currentColumn).Value
            .Cells(auftragRow, currentColumn).Value = alterWert + wert
        End If

    End With
End Sub
Sub AddNetzplanVRG(ByVal netzplan As String, ByVal vrg As String, ByVal wert As Integer)
    Dim netzplanvrgRow As Integer
    netzplanvrgRow = 0
    With Tabelle1
        ' suchen des netzplan unter bereits eingetragenen
        For currentRow = 7 To LetzteMonatsübersichtZeile()
            If .Cells(currentRow, 5).Value = netzplan And .Cells(currentRow, 6).Value = vrg Then
                netzplanvrgRow = currentRow
                Exit For
            End If
        Next currentRow
        ' nichts gefunden -> neuen eintrag erzeuegen
        If netzplanvrgRow = 0 Then
            netzplanvrgRow = LetzteMonatsübersichtZeile()
            .Cells(netzplanvrgRow, 5).Value = netzplan
            .Cells(netzplanvrgRow, 6).Value = vrg
            .Cells(netzplanvrgRow, currentColumn).Value = wert
        Else
            Dim alterWert As Integer
            alterWert = .Cells(netzplanvrgRow, currentColumn).Value
            .Cells(netzplanvrgRow, currentColumn).Value = alterWert + wert
        End If

    End With
End Sub
Function LetzteMonatsübersichtZeile() As Integer
    currentRow = 7
    With Tabelle1
        kst = .Cells(currentRow, 3)
        auftrag = .Cells(currentRow, 4)
        netzplan = .Cells(currentRow, 5)
        Do While (kst <> "" Or auftrag <> "" Or netzplan <> "")
            currentRow = currentRow + 1
            kst = .Cells(currentRow, 3)
            auftrag = .Cells(currentRow, 4)
            netzplan = .Cells(currentRow, 5)
        Loop
    End With
    LetzteMonatsübersichtZeile = currentRow
End Function

Function LetzteNamenSpalte() As Integer
    currentCol = 7
    With Tabelle1
        benutzerName = .Cells(6, currentCol)
        Do While (benutzerName <> "")
            currentCol = currentCol + 1
            benutzerName = .Cells(6, currentCol)
        Loop
        LetzteNamenSpalte = currentCol
    End With
End Function

Sub Summeerstellen()
    summe = 0
    Dim letzteSpalte As Integer
    
    letzteSpalte = LetzteNamenSpalte()
 
    With Tabelle1
        ' Überschrift hinzufügen
        .Cells(6, letzteSpalte).Value = "Summe"
        .Cells(6, letzteSpalte).Font.Bold = True
        'durch die Zeilen gehen
        For currentRow = 7 To LetzteMonatsübersichtZeile() - 1
            'Spaltenwerte addieren
            For i = 7 To letzteSpalte
                summe = summe + .Cells(currentRow, i)
            Next i
            'Summe eintragen
            .Cells(currentRow, letzteSpalte).Value = summe
            'Summe Null setzen
            summe = 0
        Next currentRow
    End With
End Sub

 

Hallo nochmal,

ich bin grad dabei diese Nulllöschgeschichte zu programmieren.
Könnte mir vielleicht jemand sagen wo an diesem Programmierungsstück der Fehler liegt?

Code:

Sub Summeerstellen()
    summe = 0
    Dim letzteSpalte As Integer
    
    letzteSpalte = LetzteNamenSpalte()
 
    With Tabelle1
        ' Überschrift hinzufügen
        .Cells(6, letzteSpalte).Value = "Summe"
        .Cells(6, letzteSpalte).Font.Bold = True
        'durch die Zeilen gehen
        For currentRow = 7 To LetzteMonatsübersichtZeile() - 1
            'Spaltenwerte addieren
            For i = 7 To letzteSpalte
                summe = summe + .Cells(currentRow, i)
            Next i
            'Summe eintragen
            .Cells(currentRow, letzteSpalte).Value = summe
            'Summe Null setzen
            summe = 0
        Next currentRow
        
        If letzteSpalte = 0 Then
        Set currentRow = currentCol
        currentRow.ClearContents
        
        If currentCol <> "" Then
        
    End If
        
    End
End Sub

Danke für alle die sich Zeit nehmen