nun moechte ich mit einem macro eine tabelle2 erstellen die die jeweiligen werte von a,b,..,x addiert und den jeweils ersten wert von a,b,..,x in einer zeile enthaelt.
weil ich nie genau weis wieviel daten ich zu a,b,c..x habe und es durchaus sein kann dass es ein x gibt das nur einen satz enhaellt... ich dachte da eher an so eine Do While Not IsEmpty(zeile) Loop der das alles selbststaendig macht bis tabelle1 ende ist. der mir paktisch die werte ja a,b,..x kumuliert in tabelle2 und bei einem neuem a,b,..,x eine neue zeile erstellt.
ich wollte nix manuell machen.. aber danke fuer die schnelle antwort
Hallo, ich habe mal eine Tabelle erstellt, die für jeden Eintrag die summe und das erste auftretende Datum (tabelle2, spalteC) oder das kleinste(früheste) Datum (tabelle2, spalteD)zurückgibt.
Sub Spezial_Summieren()
Dim nTab1 As Long
Dim nTab2 As Long
Dim ersteZeileTab1 As Integer
Dim ersteZeileTab2 As Integer
Dim anzTab2 As Long
Dim TMP As String
Dim letzteZeile As Long
Dim B As Double
'Erste Zeile (Beginnzeile) mit Buchstabe in Tabelle1
ersteZeileTab1 = 5
'Erste Zeile mit gesammelten (addierten)Artikel in Tabelle2
ersteZeileTab2 = 5
'Letzte Zeile mit einem Wert der Spalte A
letzteZeile = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'wenn nur eine Zeile, dann Abbruch
If ersteZeileTab1 = letzteZeile Then Exit Sub
'Schritt 1
'--------------------------------------------------------------------
anzTab2 = 0
'Alle Buchstaben der Tabelle1 nacheinander durchlaufen
For nTab1 = ersteZeileTab1 To letzteZeile
'Überprüfen, ob Buchstabe der Tabelle1 schon in Liste der Tabelle2 vorkommt
TMP = Sheets(1).Cells(nTab1, 1)
For nTab2 = ersteZeileTab2 To (ersteZeileTab2 + anzTab2 - 1)
If TMP = Sheets(2).Cells(nTab2, 1) Then 'genaue Übereinstimmuung
GoTo Nächster_Artikel
End If
Next nTab2
'Buchstabe in Tabelle2 eintragen
Sheets(2).Cells(ersteZeileTab2 + anzTab2, 1) = Sheets(1).Cells(nTab1, 1)
'Erster Wert der Spalte B eintragen
Sheets(2).Cells(ersteZeileTab2 + anzTab2, 2) = Sheets(1).Cells(nTab1, 2)
'Anzahl der gesammelten Buchstaben um 1 erhöhen
anzTab2 = anzTab2 + 1
Nächster_Artikel:
Next nTab1
'Schritt 2
'--------------------------------------------------------------------
For nTab2 = ersteZeileTab2 To (ersteZeileTab2 + anzTab2 - 1)
For nTab1 = ersteZeileTab1 To letzteZeile
If Sheets(1).Cells(nTab1, 1) = Sheets(2).Cells(nTab2, 1) Then
B = B + Sheets(1).Cells(nTab1, 2)
End If
Next nTab1
'Werte in Tabelle2 schreiben
Sheets(2).Cells(nTab2, 3) = B
Next nTab2
End Sub
oki danke das waren gute loesungsansaetze ich werde sie jetzt mal versuchen auf mein problem anzupassen, das ja um einiges groesser ist als die abstrahierte beispielform.
danke allen helfenden und erklaere den thread als geschlossen,
bye und schoenes wochenende.
Betrifft: AW: HILFE!! gleiche zeilenzelle inhalte addieren
von: Hans W. Hofmann
Geschrieben am: 04.10.2003 16:27:01
Da sollen aber drei Aufgaben auf einmal erschlagen werden. Ich würde sowas wie eine Array-Funktion nehmen:
Die Übergabewerte: -Key der BEreich mit den a's und b's, z.B. A1:A20 -Summe der zu summierende Bereich, z.B. B1:B20 Die Funktion AddKey benötigt 3 Spalten und n Zeilen wird z.B. im Bereich D1:D20 eingegeben - markieren =addkey(A1:A20;B1:B20) Eingabe Shift+Strg+Enter Ergebnis in D1:D20 {=addkey(A1:A20;B1:B20)} Der Ausgabebereich könnte latürnich "kürzer" gehalten werden, wenn man über die Anzahl der verschiedenen Key-Werte näheres wüsste... Die Funktion hat keine Fehlerprüfung: Die BEreiche Key und Summe sollten also gleich "lang" sein!
Gruß HW
Function AddKey(Key As Range, Summe As Range)
' 03(C)oded by hw - Return Array(n,3) - no ErrorcheckingDim KeySum()
Dim KeyCode AsNewCollectionDim i AsLongReDim KeySum(1 To Summe.Rows.Count, 1 To 3)
OnErrorResumeNextFor i = 1 To Summe.Rows.Count
KeyCode.Add i, CStr(Key(i))
If Err.Number = 0 Then
KeySum(KeyCode.Count, 1) = Key(i)
KeySum(KeyCode.Count, 2) = Summe(i)
KeySum(KeyCode.Count, 3) = Summe(i)
Else
Err.Clear
KeySum(KeyCode(Key(i)), 3) = KeySum(KeyCode(Key(i)), 3) + Summe(i)
EndIfNext
AddKey = KeySum
EndFunction
Betrifft: AW: HILFE!! gleiche zeilenzelle inhalte addieren
von: Hans W. Hofmann
Geschrieben am: 04.10.2003 17:05:36
Ajee, Fehler die Zeile KeyCode.Add i, CStr(Key(i)) muss lauten KeyCode.Add KeyCode.Count + 1, CStr(Key(i))
Gruß HW
Beiträge aus den Excel-Beispielen zum Thema " HILFE!! gleiche zeilenzelle inhalte addieren "