Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 15:03:35
Unterschiedliche Dateien miteinander abgleichen lassen
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
284to288
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
284to288
284to288
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

zusammenziehen mehrerer Zeilen

zusammenziehen mehrerer Zeilen
23.07.2003 09:11:41
silvia
Hallo Halli.
Nachdem ich nicht da war und gebeten wurde, eine Testdatei wegen Makro auf den Server zu laden, hier nochmal mein Anliegen:
Ich habe eine riesige Excel-Tabelle, in der Namen mehrmals vorkommen können. Ich hätte nun gern ein Makro, was ich in einem neuen Datenblatt angestoße, das mir die Ur-Tabelle nach den Namen durchsucht, wenn es ihn findet in das Datenblatt schreibt und die Summe der Daten aus der Spalte B dazu schreibt:
Name A 3
Name C 2
Name A 4
Name B 4
Name A 1
Name C 2
Ziel:
Name A 8
Name B 4
Name C 4
Vieeelen Dank!
Silvia

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: zusammenziehen mehrerer Zeilen
23.07.2003 09:13:40
silvia
So. hier ist die Testdatei. Die grau hinterlegte Spalte Z ist die Spalte, deren Werte zusammenaddiert werden sollen, wenn ein Name mehrmals vorkommt
Herzlichen Dank!
Silvia
https://www.herber.de/bbs/user/317.xl

AW: auch bei unterschiedlichen Monaten?
23.07.2003 09:41:04
Nike
Hi,
soll trotz unterschiedlicher Monate zusammengezogen werden?
Bye
Nike

AW: Ein Ansatz...
23.07.2003 13:05:50
Nike
Hi,
naja, mal ein Ansatz:

Sub reduceSumDB()
Dim wks As Worksheet
Dim lngZeil As Long
Dim lngSZeil As Long
Dim lngLZeil As Long
Dim lngWZeil As Long
Dim intFSpalt As Integer ' Spalte in der gefunden werden soll
Dim intSSpalt As Integer ' Spalte in der summiert werden soll
Dim rng As Range
Set wks = Worksheets(1)
intSSpalt = 26
intFSpalt = 3
lngZeil = 2
lngLZeil = wks.Cells(wks.Rows.Count, intFSpalt).End(xlUp).Row
Do
Set rng = wks.Range(wks.Cells(lngZeil + 1, intFSpalt), wks.Cells(lngLZeil, intFSpalt)).Find(wks.Cells(lngZeil, intFSpalt))
Do Until rng Is Nothing
lngWZeil = rng.Row
wks.Cells(lngZeil, intSSpalt) = wks.Cells(lngZeil, intSSpalt) + wks.Cells(lngWZeil, intSSpalt)
Rows(lngWZeil).Delete
lngLZeil = wks.Cells(wks.Rows.Count, intFSpalt).End(xlUp).Row
Set rng = wks.Range(wks.Cells(lngWZeil, intFSpalt), wks.Cells(lngLZeil, intFSpalt)).Find(wks.Cells(lngZeil, intFSpalt))
Loop
lngZeil = lngZeil + 1
Loop Until lngZeil = wks.Cells(wks.Rows.Count, intFSpalt).End(xlUp).Row
End Sub

Bye
Nike

Anzeige
AW: Ein Ansatz...
23.07.2003 13:24:44
silvia
Also. Ich bin da ja völlig unbedarft. Ich hab das Makro mal angestoßen, dann fing Excel an zu rödeln (man sieht halt, wie die Seiten scrollen) bis zum ultimo. Ich habe dann irgendwann mit Esc abgebrochen. Anschließend war die Tabelle komplett leer.
Muß ich irgendwas bei dem makro beachten?????

AW: Ein Ansatz...
23.07.2003 13:59:01
Nike
Hi,
ich hab hier mal die Datei hinterlegt.
https://www.herber.de/bbs/user/320.xl
Die Tabellenstruktur muß beibehalten werden,
sonst mußt du den Code anpassen...
Einfach mal Tabelle 1 auswählen
und die Prozedur reduceSumDB ausführen...
Bye
Nike

Anzeige
geht immer noch nicht :-(
23.07.2003 14:26:37
silvia
Also ich habe mir die Datei runtergeladen uns ausprobiert - geht super.
Dann habe ich einfach meine Datei hergenommen, parallel die runtergeladene Testdatei geöffnet und die Prozedur gestartet. Dann fängt Excel wieder an zu scrollen ohne Ende und hört gar nicht mehr auf. Ich mußte dann mit Esc abbrechen und das Tabellenblatt war dann leer :'-((( Ich habe schon nachgeschaut, die Spalten sind original die selben...

AW: geht immer noch nicht :-(
23.07.2003 14:42:50
Nike
Hi,
dann öffne deine Datei, aktivieren dein Blatt
(das hoffentlich wirklich den gleichen Aufbau hat)
und starte über die Tastenkombination Alt+F8 das Makro...
Was in meiner Datei funkt sollte es ja eigentlich auch in Deiner ;-)
Bye
Nike

Anzeige
AW: geht immer noch nicht :-(
23.07.2003 14:48:27
silvia
Naja, eben das hatte ich ja gemacht.
Der Bildschirm sieht dann aus, als Excel da seitenweise runterscrollt (Bildschirm flimmert) und dann sieht man, wie alle Einträge zusammengezogen werden und irgendwann ist der Bildschirm leer. Dann rödelt Excel immer weiter und ich breche dann ab.
In der Datei sind bisher 478 Zeilen und das werden mit Sicherheit noch mehr werden...

AW: debugging...
23.07.2003 15:22:12
Nike
Hi,
dann kann ich dir nur noch empfehlen den Code in deine Datei
zu übertragen und dann per F8 Schrittweise durch den Code zu steppen
und zu schauen, wo da die Endbedingung bei deiner Datei nicht greift...
Beruhigenderweise hat ja die gepostete Datei soweit gefunkt ;-)
Bye
Nike

Anzeige
Deine Testdatei funktioniert auch nur bedingt...
23.07.2003 16:51:55
silvia
Also ich habe jetzt mal testweise in Deine Datei die vorhandenen Zeilen einfach kopiert und mehrmals nacheinander eingefügt. Dann funktioniert das Makro auch nicht mehr und rödelt sich tot...
Ist da irgendwie was beim Ende falsch definiert????
Ich hab leider keine Ahnung von VBA-Programmierung...
Vielen DANK!!!!

AW: Deine Testdatei funktioniert auch nur bedingt...
24.07.2003 10:43:34
Nike
Hi,
hm, kann es mir nicht erklären, passiert wohl echt erst bei längeren Sätzen,
versuchs mal mit dem folgenden Code:

Sub reduceSumDB()
Dim wks As Worksheet
Dim lngZeil As Long
Dim lngSZeil As Long
Dim lngLZeil As Long
Dim lngWZeil As Long
Dim intFSpalt As Integer ' Finden
Dim intSSpalt As Integer ' Summieren
Dim rng As Range
Set wks = Worksheets(1)
intSSpalt = 26
intFSpalt = 3
lngZeil = 2
lngLZeil = wks.Cells(wks.Rows.Count, intFSpalt).End(xlUp).Row
Do
Set rng = wks.Range(wks.Cells(lngZeil + 1, intFSpalt), wks.Cells(lngLZeil, intFSpalt)).Find(wks.Cells(lngZeil, intFSpalt))
Do Until rng Is Nothing
If rng.Row = lngZeil Then Exit Do
lngWZeil = rng.Row
wks.Cells(lngZeil, intSSpalt) = wks.Cells(lngZeil, intSSpalt) + wks.Cells(lngWZeil, intSSpalt)
Rows(lngWZeil).Delete
lngLZeil = wks.Cells(wks.Rows.Count, intFSpalt).End(xlUp).Row
Set rng = wks.Range(wks.Cells(lngWZeil, intFSpalt), wks.Cells(lngLZeil, intFSpalt)).Find(wks.Cells(lngZeil, intFSpalt))
Loop
lngZeil = lngZeil + 1
Loop Until lngZeil >= wks.Cells(wks.Rows.Count, intFSpalt).End(xlUp).Row
End Sub

Bye
Nike

Anzeige
AW: auch bei unterschiedlichen Monaten?
23.07.2003 12:52:21
silvia
ja, genau das ist ja das ziel :-)

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige