VBA Makro Summenprodukt und Zellenvergleich

Question

Guten Abend,

brauch mal wieder Profi hilfe wenns um Makros geht.
Ich habe 2 Tabellenblätter

Tool wo mehrere Personen Tätigkeiten und Arbeitsstunden eintragen können
Auswertung wo alles zusammengefasst und die summe gebildet wird

ich brauch jetzt für die Auswertung ein makro das folgendes macht

Schreibe mir die Projekte und Workshops und die Massnahmen die du im "tool" findest in die Auswertung.
Jetzt vergleiche Spalte A & B miteinander und Bilde mir die Gesamtsumme im Jahr ( hab nur ein paar tage dargestellt, brauche aber fuers Gesamtjahr)
Und splitte mir die Gesamtsumme nochmal monatlich auf, kann sein dass fuer ein Projekt im januar 5 h gearbeitet wird, im Februar 10, in mAerz 0 usw.

Datei

http://www.file-upload.net/download-2257756/bsp.xls.html

Vielen Dank für eure Hilfe.
LG

Answer 1

Hallo,

dazu braucht man doch kein Makro, das kann man problemlos mit Formeln erschlagen.

Hier mein Vorschlag

Gruss
Rainer

Answer 2

Morgen Rainer,

erstmal danke für die schnelle Hilfe,
die Formeln funktionieren, leider dauer t alles sehr lange, in unserem Fall jetzt geht das ohne Probleme, die richtige Datei ist wesentlich komplexer, ich versuche hier das Prinzip zu verstehen und es dann zu übertragen.

zum Beispiel weiss ich nicht wie viele Zeilen das Tool irgendwann mal hat, es kommen taeglich welche dazu.
Bei meinem jetzigen Makro, schreibt er mir zwar meine projekte/ WS und aktionen rein aber bildet die summe falsch, und die summe auf den monat bezogen fehlt auch noch!
Ich poste mal den code, vll faellt euch ja was ein. Wenn ich das Makro starte dauert es auch ziemlich lange, die Zeilem bauen sich langsam nacheinander auf, irgendwo ist eine Gechwindigkeitsbremse drin!


Rem Dim intZaehler As Long, intZeile As Long, intErgebnis As Single


Dim i As Long, j As Long

intZeile = 3 ' beginne in zeile 3
ThisWorkbook.Sheets("Auswertung1").Range("A3:G65500").ClearContents ' lösche inhalte
ThisWorkbook.Sheets("Auswertung1").Range("A3:G65500").ClearFormats ' lösche formate
For intZaehler = 23 To ThisWorkbook.Sheets("Planungstool").UsedRange.Rows.Count ' ab zeile 23 bis zum letzten Eintrag im Pltool
If ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 2) <> "Abwesendheitsstunden" Then ' damit er die Abwesenheitssh nicht reinschreibt
If ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 3) <> "" Then ' Ignoriere Leerzeilen

With ThisWorkbook.Sheets("Auswertung1")

.Cells(intZeile, 1).Value = ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 2).Value ' Projektnummern listen
.Cells(intZeile, 1).Borders.LineStyle = xlContinuous
.Cells(intZeile, 2).Value = ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 3).Value ' WS Nr listen
.Cells(intZeile, 2).Borders.LineStyle = xlContinuous
.Cells(intZeile, 3).Value = ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 4).Value ' Massnahmen listen
.Cells(intZeile, 3).Borders.LineStyle = xlContinuous
.Cells(intZeile, 4).Value = ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 5).Value ' Status
.Cells(intZeile, 4).Borders.LineStyle = xlContinuous
.Cells(intZeile, 5).Value = ThisWorkbook.Sheets("Import").Cells(intZaehler, 6).Value ' Status
.Cells(intZeile, 5).Borders.LineStyle = xlContinuous
.Cells(intZeile, 6).Value = ThisWorkbook.Sheets("Planungstool").Cells(intZaehler, 1).Value ' Berater
.Cells(intZeile, 6).Borders.LineStyle = xlContinuous


' Hier lösche ich die doppelte vorkommenden Projekt/WS Nr (komplette Spalte)
'For i = 1 To Range("A1000").End(xlUp).Row
'For j = 1 To Range("A1000").End(xlUp).Row
' If Range("A" & i).Value = Range("A" & j).Value And _
' i <> j Then Range("A" & j).ClearContents
' Next
' Next

End With
intZeile = intZeile + 1

End If
End If

Rem Next

With ThisWorkbook.Sheets("Planungstool")
'On Error Resume Next
intZaehler = 2
Do While ThisWorkbook.Sheets("Auswertung1").Cells(intZaehler, 1).Value <> ""
intErgebnis = 0
For intZeile = 3 To .UsedRange.Rows.Count
If ThisWorkbook.Sheets("Auswertung1").Cells(intZaehler, 1).Value = .Cells(intZeile, 3).Value Then
intErgebnis = intErgebnis + Application.WorksheetFunction.Sum(.Range(.Cells(intZeile, 6), .Cells(intZeile, 243))) ' summe januar bis dezember

End If

Next intZeile
With ThisWorkbook.Sheets("Auswertung1")
.Cells(intZaehler, 7) = intErgebnis
.Cells(intZaehler, 7).Borders.LineStyle = xlContinuous
End With
intZaehler = intZaehler + 1

Loop

'On Error GoTo 0

End With



End Sub


Gruss

Answer 3

Hallo,

....des Menschen Wille ist sein Himmelreich :-), deshalb will ich Dir Dein Makro auch nicht ausreden.

Vielleicht biegt es Dir jemand gerade.

Was meine Formel betrifft:

zum Beispiel weiss ich nicht wie viele Zeilen das Tool irgendwann mal hat, es kommen taeglich welche dazu.

...die Anzahl der Zeilen spielt keine Rolle, man braucht die Formeln nur nach Bedarf nach unten kopieren.

leider dauert alles sehr lange

...dem könnte man noch etwas entgegen wirken, indem man dynamische Bereichsnamen definiert.
Dazu müsste man aber die Strukturen beider Arbeitsblätter genau kennen.

Gruss
Rainer

Answer 4

Ja stimmt, hast schon recht, aber es würde nicht funktionieren, weil auch viele Leerzeilen und Zeilen mit Erklärungen drin stehen,
Z.B Abwesenheitsstunden etc, diese werden wenn ich mit formeln hinterlege mitgenommen und das sieht ganz hässlich aus, jetzt hab ich angst wenn ich dann mit nem Makro drüberlaufe und allen Mist rauslösche das Summenprodukt falsch wird!

Es wäre also toll alles mit nem Makro zu lösen

Answer 5

Hallo,

Es wäre also toll alles mit nem Makro zu lösen

...so soll es auch bleiben, habe nichts dagegen.

Wollte nur noch sagen, dass man Formeln auch, fast beliebig, anpassen kann.
Leider konnte ich Dir bisher, mangels ungenügender Inhalts- u. Strukturkenntnis, keine solche Anpassung bieten.

Gruss
Rainer