|
Hallo zusammen,
ich bin auf ein kleines Problem bei meinen VBA Skript gestoßen.
Ich benötige einen Code, der die Summer bildet, wenn der Name in Spalte H, die KW in Spalte E und das Jahr in Spalte C den zuvor eingegebenen Parametern entsprechen. Also das Skript soll in die Summe von bsp Spalte J bilden für alle Daten, welche den Parametern entsprechen. Dies soll für die Spalten J, L, M, N, O in der Registerkarte Rohdaten geschehen und in die Registerkarte Rohdaten_MA_KW übertragen werden.
Für die Spalten K, P, Q, R das gleiche als Mittelwert.
Bin bis jetzt so weit:
Sub Rohdaten_MA_KW_anlegen()
'Parameter Eingabe
Dim z1 As Long
Dim z2 As Long
Dim z3 As Long
Dim Monat As String
Dim Agentenname As String
Dim Jahr As String
Dim KW As String
Dim Start_KW As String
Dim Checks_alt As String
Dim Datum As String
'Abfrage ab welcher KW die Daten übertragen werden sollen?
Start_KW = InputBox("Bitte Kalenderwoche eingeben, ab welcher die Daten übertragen werden sollen !", "Aktualisieren")
Select Case Start_KW
'Abbruch der Prozedur wenn "Abrechen" angeklickt wurde
Case ""
Exit Sub
End Select
'Bildschirmaktuallisierung abschalten
Application.ScreenUpdating = False
'Festlegen wo begonnen wird
Windows("Teamvergleich_Qualitichecks.xlsm").Activate
Sheets("Rohdaten").Select
For z1 = 2 To 10000000
Sheets("Rohdaten").Select
If Cells(z1, "G").Value = "" Then
GoTo Ende
End If
Sheets("Rohdaten").Select
Monat = Cells(z1, "D")
Agentenname = Cells(z1, "H")
Jahr = Cells(z1, "C")
KW = Cells(z1, "E")
'Wenn die KW in der Zeile kleiner ist als die ab welcher begonnen werden soll, dann nächste Zeile
If KW < Start_KW Then
GoTo Weiter
End If
'In Rohdaten_MA_KW Prüfen ob diese KW vorhanden
Sheets("Rohdaten_MA_KW").Select
For z2 = 2 To 10000000
'Wenn noch kein Datensatz für diese Person zu der Zeil exsistiert, wird einer angelegt. Bei Sprungmarke Daten_Einpflegen
If Cells(z2, "B").Value = "" Then
GoTo Daten_Einpflegen
End If
'Prüfen ob ein Datensatz exsistiert mit den gleichen Parametern (KW, Name, Monat)
If Cells(z2, "H").Value = Agentenname Then
If Cells(z2, "C").Value = Jahr Then
If Cells(z2, "D").Value = Monat Then
If Cells(z2, "E").Value = KW Then
'Summe der Checks welche zuvor eingetragen waren
Checks_alt = Cells(z2, "P").Value + Cells(z2, "Q").Value + Cells(z2, "R").Value
'Alte Daten Löschen
Range(Cells(z2, "I"), Cells(z2, "AH")).Select
Selection.ClearContents
'hier fehlt mir der Code -->
Könnt Ihr mir hier weiterhelfen? Bitte
VG
Christoph |