Live-Forum - Die aktuellen Beiträge
Datum
Titel
26.04.2024 21:51:33
Idee für Grafik
26.04.2024 21:29:07
PQ zufällige Reihenfolge
26.04.2024 17:18:47
Große Datenmenge in komplexes Diagramm verpacken
26.04.2024 16:22:47
Aktualisierung Verknüpfung bei geschlossener Quelldatei
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1128to1132
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1128to1132
1128to1132
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bestimmten Wert in doppelten Zeilen addieren

Bestimmten Wert in doppelten Zeilen addieren
Timo
Hallo zusammen,
zuerst einmal ein dickes Lob an dieses geniale Forum hier.
Eure Beiträge haben mir schon oft bei verzwickten Aufgabenstellungen geholfen.
Leider habe ich zu meinem aktuellen Problem noch keine Lösung gefunden.
Aber dies ist sicher kein Problem für Euch.
Die Lösung soll über VBA realisiert werden.
Problem:
Ich habe eine Tabelle mit 4 Spalten und sehr vielen Datensätzen.
Ich möchte gern, dass Excel die Werte in Spalte A, B und C in allen Zeilen vergleicht.
Wenn der Wert in Spalte A, B und C in mehreren Zeilen vorkommt, soll in den Zeilen die Werte in Spalte D
addiert werden und die doppelten Zeilen gelöscht werden.
Z.B.:
Musterkind 123 Apfel 2
Musterfrau 123 Birne 3
Musterkind 234 Apfel 3
Musterfrau 222 Melone 1
Musterfrau 123 Birne 2
soll dann so aussehen: (zweiter und letzter Eintrag sollen zusammengefasst werden)
Musterkind 123 Apfel 2
Musterfrau 123 Birne 5
Musterkind 234 Apfel 3
Musterfrau 222 Melone 1
Es soll also nur Zeilen betreffen, wo wirklich Spalte A, B und C gleich ist.
Diese Zeilen sollen dann zusammengefasst werden, indem der Wert in Spalte D addiert wird
und die doppelten Zeilen gelöscht werden.
Ich hoffe, ich konnte es einigermaßen verständlich rüberbringen...
Vielen Dank
Gruß Timo
AW: Bestimmten Wert in doppelten Zeilen addieren
20.01.2010 14:14:31
Tino
Hallo,
kannst mal diesen Code testen.
Sub Test()
Dim meAr(), tmpAr()
Dim myDic As Object
Dim sString As String
Dim A As Long, AA As Long

With Sheets("Tabelle1") 'Tabelle anpassen 
    Set myDic = CreateObject("Scripting.Dictionary")
    meAr = .Range("A2", .Cells(.Rows.Count, 4).End(xlUp)).Value2
    Redim Preserve tmpAr(1 To 3, 1 To Ubound(meAr))
    
    For A = 1 To Ubound(meAr)
     sString = meAr(A, 1) & meAr(A, 2) & meAr(A, 3)
     If Not myDic.exists(sString) Then
      myDic(sString) = 0
      AA = AA + 1
      tmpAr(1, AA) = meAr(A, 1)
      tmpAr(2, AA) = meAr(A, 2)
      tmpAr(3, AA) = meAr(A, 3)
     End If
     
     myDic(sString) = myDic(sString) + meAr(A, 4)
    Next A
    
    Redim Preserve tmpAr(1 To 3, 1 To AA)
    tmpAr = Application.Transpose(tmpAr)
    
    .Range("A2:D" & .Rows.Count).ClearContents
    .Range("A2").Resize(Ubound(tmpAr), Ubound(tmpAr, 2)) = tmpAr
    .Range("D2").Resize(myDic.Count) = Application.Transpose(myDic.items)
End With
End Sub
Gruß Tino
Anzeige
@Tino-Array ?
20.01.2010 19:38:48
robert
hi Tino,
ich kapier diese Array's nicht :-((
wie müsste man den code ändern, wenn zB. die 3.spalte als mengensumme
ausgewiesen werden soll ?
gruß
robert
Summe in Spalte C
20.01.2010 20:11:22
Tino
Hallo Robert,
wenn der Aufbau der Tabelle so aussieht
 ABCD
1ÜberschriftÜberschriftÜberschriftÜberschrift
2Musterkind1232Apfel
3Musterfrau1233Birne
4Musterkind2343Apfel
5Musterfrau2221Melone
6Musterfrau1232Birne

Dann müsste man den Code so anpassen.
Sub Test()
Dim meAr(), tmpAr()
Dim myDic As Object
Dim sString As String
Dim A As Long, AA As Long

With Sheets("Tabelle1") 'Tabelle anpassen 
    Set myDic = CreateObject("Scripting.Dictionary")
    meAr = .Range("A2", .Cells(.Rows.Count, 4).End(xlUp)).Value2
    Redim Preserve tmpAr(1 To 4, 1 To Ubound(meAr))
    
    For A = 1 To Ubound(meAr)
     sString = meAr(A, 1) & meAr(A, 2) & meAr(A, 4)
     If Not myDic.exists(sString) Then
      myDic(sString) = 0
      AA = AA + 1
      tmpAr(1, AA) = meAr(A, 1)
      tmpAr(2, AA) = meAr(A, 2)
      tmpAr(4, AA) = meAr(A, 4)
     End If
     
     myDic(sString) = myDic(sString) + meAr(A, 3)
    Next A
    
    Redim Preserve tmpAr(1 To 4, 1 To AA)
    tmpAr = Application.Transpose(tmpAr)
    
    .Range("A2:D" & .Rows.Count).ClearContents
    .Range("A2").Resize(Ubound(tmpAr), Ubound(tmpAr, 2)) = tmpAr
    .Range("C2").Resize(myDic.Count) = Application.Transpose(myDic.items)
End With
End Sub
Gruß Tino
Anzeige
ohne Re- Dimensionierung
20.01.2010 20:17:34
Tino
Hallo Robert,
in diesem Fall kann man
ReDim Preserve tmpAr(1 To 4, 1 To AA)
auch weg lassen weil dieses Array nach unten sowieso leer und die gleiche größe wie meAr aufweist.
Gruß Tino
so müsste es gehen.
20.01.2010 21:24:09
Tino
Hallo,
Sub Test()
Dim meAr(), tmpAr()
Dim myDic As Object, myDicMenge As Object
Dim A As Long, AA As Long

With Sheets("Tabelle1") 'Tabelle anpassen 
    Set myDic = CreateObject("Scripting.Dictionary")
    Set myDicMenge = CreateObject("Scripting.Dictionary")
    meAr = .Range("A2", .Cells(.Rows.Count, 3).End(xlUp)).Value2
    Redim Preserve tmpAr(1 To Ubound(meAr), 1 To 3)
    
    For A = 1 To Ubound(meAr)
        If Not myDic.exists(meAr(A, 1)) Then
         myDic(meAr(A, 1)) = 0
         AA = AA + 1
         tmpAr(AA, 1) = meAr(A, 1)
        End If
     
        myDic(meAr(A, 1)) = myDic(meAr(A, 1)) + meAr(A, 2)
        myDicMenge(meAr(A, 1)) = myDicMenge(meAr(A, 1)) + meAr(A, 2) * meAr(A, 3)
    Next A
    
    .Range("A2:C" & .Rows.Count).ClearContents
    .Range("A2").Resize(Ubound(tmpAr)) = tmpAr
    .Range("B2").Resize(myDic.Count) = Application.Transpose(myDic.items)
    .Range("C2").Resize(myDicMenge.Count) = Application.Transpose(myDicMenge.items)
End With
End Sub
Gruß Tino
Anzeige
So geht es ! :-) Danke Tino-Gruß
20.01.2010 21:39:59
robert
DANKE!
21.01.2010 11:37:22
Timo
Hallo Tino,
funktioniert wunderbar.
Kann sein, dass die Tabelle noch erweitert werden muss.
Falls ich es nicht selbst hinbekomme, würde ich mich noch einmal bei Dir melden.
Vielen Dank für die schnelle Hilfe!
Gruß Timo
ok. danke für die Rückmeldung. oT.
21.01.2010 13:32:16
Tino
AW: Bestimmten Wert in doppelten Zeilen addieren
22.01.2010 00:00:33
Timo
Hallo Tino,
jetzt muss ich mich doch noch einmal melden.
Ich bin am verzweifeln, ich steige bei deinem Code einfach nicht dahinter.
Wie müsste denn der Code aussehen, wenn noch eine Spalte dazu kommt.
Und zwar so:
Musterkind 123 Apfel Rot 2
Musterfrau 123 Birne Gelb 3
Musterkind 234 Apfel Grün 3
Musterfrau 222 Melone Grün1
Musterfrau 123 Birne Grün 2
Es sollen aber nur Spalte A, B und C verglichen werden.
Wenn in einer weiteren Zeile Spalte A, B und C überein stimmt, dann halt wieder die letzte Spalte (E) dazu addieren und doppelte Zeilen löschen.
Was in Spalte D steht, spielt dabei keine Rolle.
So müsste das dann wieder aussehen (zweiter und letzter Eintrag zusammengefast)
Musterkind 123 Apfel Rot 2
Musterfrau 123 Birne Gelb 5
Musterkind 234 Apfel Grün 3
Musterfrau 222 Melone Grün1
Vielen Dank im Voraus
Gruß Timo
Anzeige
AW: Bestimmten Wert in doppelten Zeilen addieren
22.01.2010 00:21:37
Tino
Hallo,
müsste so funktionieren.
Sub Test()
Dim meAr(), tmpAr()
Dim myDic As Object
Dim sString As String
Dim A As Long, AA As Long

With Sheets("Tabelle1") 'Tabelle anpassen 
    Set myDic = CreateObject("Scripting.Dictionary")
    meAr = .Range("A2", .Cells(.Rows.Count, 5).End(xlUp)).Value2
    Redim Preserve tmpAr(1 To 4, 1 To Ubound(meAr))
    
    For A = 1 To Ubound(meAr)
     sString = meAr(A, 1) & meAr(A, 2) & meAr(A, 3)
     If Not myDic.exists(sString) Then
      myDic(sString) = 0
      AA = AA + 1
      tmpAr(1, AA) = meAr(A, 1)
      tmpAr(2, AA) = meAr(A, 2)
      tmpAr(3, AA) = meAr(A, 3)
      tmpAr(4, AA) = meAr(A, 4)
     End If
     
     myDic(sString) = myDic(sString) + meAr(A, 5)
    Next A
    
    Redim Preserve tmpAr(1 To 4, 1 To AA)
    tmpAr = Application.Transpose(tmpAr)
    
    .Range("A2").Resize(Ubound(meAr), Ubound(meAr, 2)).ClearContents
    .Range("A2").Resize(Ubound(tmpAr), Ubound(tmpAr, 2)) = tmpAr
    .Range("E2").Resize(myDic.Count) = Application.Transpose(myDic.items)
End With
End Sub
Gruß Tino
Anzeige
AW: Bestimmten Wert in doppelten Zeilen addieren
23.01.2010 12:17:24
Timo
Hallo,
funktioniert bestens!
Vielen Dank für Deine Bemühungen...
Gruß Timo

315 Forumthreads zu ähnlichen Themen

Zeilen in Zellen suchen und löschen
Daniel

Hallo,
ich möchte in Excell mehrere Zelle suchen, die folgenden String in einer oder mehreren Zeilen enthalten: ----
Diese Zeilen möchte ich dann löschen. Nach diesem String sind noch weitere Zeichen vorhanden, die auch gelöscht werden sollen.
Weiß jemand wie ich am besten vorgehe?...
13.08.2008 12:52:02
Thread-ID: 1001495
9 Beiträge
Anzeige
Letzen wert in Zeile(nicht Spalte)
hary

Nabend alle miteinander
In einer bestimmten Zeile suche ich den letzten Eintrag. Bis zu diesem soll gefaerbt werden. Mit diesem Code faerbe ich den ganzen Bereich, es soll aber nur bis zum letzten Eintrag in der Zeile gefaerbt werden. Da von links nach rechts gefaerbt.
Case Is = Cells...
28.08.2008 21:25:00
Thread-ID: 1005592
5 Beiträge
Zeile mit Werten aus anderer Tabelle vergleichen
onkelbobby

Hi,
ich versuche folgendes in meine Datei einzubauen.
Tabelle 2 enthält Adressdaten und eine Infospalte. In diese Infospalte kann der Wert "S" oder der Wert "A" eingetragen werden.
In Tabelle 1 sind auch diverse Adressdaten gepflegt. Alle Adressen in Tabelle 1 sind auch in Tabelle 2...
29.08.2008 10:37:00
Thread-ID: 1005722
3 Beiträge
Anzeige
Wert innerhalb Array suchen
David

Hallo VBAler,
wenn ich ein Array in der Form
treffer_n(n)
habe, gibt es da eine schnelle und einfache Möglichkeit zu prüfen, ob ein bestimmter Wert in diesem Array vorhanden ist, oder muss ich alle Werte per Schleife einzeln prüfen lassen?
Gruß
David
19.09.2008 08:48:14
Thread-ID: 1010894
3 Beiträge
Text verbinden und den Inhalt der Zelle ausgeben
Jörg

Hallo,
ich benötige etwas Hilfe, vermutlich für euch kein Problem:
in Zelle A1 möchte ich den Spaltenbuchstaben eintragen
in Zelle A2 möchte ich eine Zeilennummer eintragen
in Zelle A3 fehlt mir nun die Formel, mit der ich A1undA2 verbinden kann UND dann den Inhalt der Zelle aus...
19.09.2008 11:42:31
Thread-ID: 1010969
6 Beiträge
In Textfile bestimmte Zeile suchen
Pascal

In einem Textfile soll nach einer bestimmten Zeile (immer der gleiche Text) gesucht werden.
Wird dieser Text gefunden, so soll alles vom Beginn weg des Textfiles bis und mit dieser Zeile (plus zusätzlich noch die nächste Zeile) gelöscht werden.
Geht das irgendwie ?
Wenn ja, wie ?
24.09.2008 16:14:00
Thread-ID: 1012111
8 Beiträge
Zeilen autom nach Werten d. Spalte C sortieren
obelix-xxl

Hallo,
ich bitte um Unterstützung bei der Lösung mittels Makro für nachfolgende Aufgabenstellung.
Im aktuellen Tabellenblatt "Raum 1" sind in der Spalte C einer jeden Zeile ganze Zahlen von 1 bis 30 eingetragen. Diese Zeilen sollen automatisch nach Eingabe des Wertes in Spalte C sortier...
02.10.2008 09:16:11
Thread-ID: 1013794
15 Beiträge
zeile ermitteln, werte prüfen
sonja

hallo ihr lieben,
ich hoffe ihr könnt mir auch dieses mal wieder helfen.
ich möchte in einer zeile (die sich ständig ändert letzte beschriebene zeile minus 6)
in jeder spalte prüfen ob der wert kleiner als ... ist, wenn dies zutrifft sollte sich eine userform
mit einem hinweis...
10.10.2008 16:55:00
Thread-ID: 1015638
11 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
8
5
4
2
7
2
5
7
14
10
4
6
6
12
6
1
11
2
3
6
1
4
2
1
4