Monatsdatenspannen summieren :: Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office

Einloggen, um private Nachrichten zu lesen

Downloads

Monatsdatenspannen summieren

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Autor

Nachricht

Aylona
Newbie
Newbie

Anmeldedatum: 25.06.2008
Beiträge: 2

Verfasst am: 25.06.2008, 22:43

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 Embarassed

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

Aylona
Newbie
Newbie

Anmeldedatum: 25.06.2008
Beiträge: 2

Verfasst am: 26.06.2008, 14:31

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

Office-Hilfe.com - Wir lösen Ihre Probleme mit Microsoft Office Foren-Übersicht » Microsoft Excel Hilfe

Thema		Autor	Forum	Antworten	Verfasst am
Ähnliche Beiträge
	Summieren über Tabellenblätter	Metzei	Microsoft Excel Hilfe	2	07.11.2008, 14:21
	Problem beim Summieren	miniB	Microsoft Excel Hilfe	1	26.09.2008, 10:20
	Außerhalb einer Pivot Tabelle summier...	rocktodd	Microsoft Excel Hilfe	2	19.09.2008, 12:59
	Summieren	saschathede	Microsoft Excel Hilfe	1	09.07.2008, 09:53
	ZUSAMMENFASSEN UND SUMMIEREN	saschathede	Microsoft Excel Hilfe	2	25.06.2008, 14:46

Gehe zu:

Du kannst keine Beiträge in dieses Forum schreiben.
Du kannst auf Beiträge in diesem Forum nicht antworten.
Du kannst deine Beiträge in diesem Forum nicht bearbeiten.
Du kannst deine Beiträge in diesem Forum nicht löschen.
Du kannst an Umfragen in diesem Forum nicht mitmachen.
Du kannst Dateien in diesem Forum posten
Du kannst Dateien in diesem Forum herunterladen

Powered by phpBB © 2001, 2002 phpBB Group :: FI Theme :: Alle Zeiten sind GMT + 1 Stunde
Deutsche Übersetzung von phpBB.de