Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
632to636
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
632to636
632to636
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Daten zusammenfügen

Daten zusammenfügen
07.07.2005 02:54:48
Tom
Hallo zusammen,
ich bräuchte ein kleines Excel Makro das die nachfolgenden Schritte selbständig und unkompliziert ausführt und hoffe hier bei Euch ein kleinen Tipp/Beispiel zu erhalten.
Zum Verständnis:
Ich habe eine Arbeitsmappe mit drei Tabellenblättern (gesamt, daten_1 und daten2). Nun die durchzuführenden Schritte...
Schritt 1 = Im Tabellenblatt "daten_1" sollen alle Zellen der Spalte A die Daten enthalten (Bsp.: A1-A220 sind mit Daten gefüllt, Liste wächst aber permanent) markiert und ins Tabellenblatt "gesamt" in die Spalte A (Bsp.: A1-A220) kopiert werden.
Schritt 2 = Im Tabellenblatt "daten_2" sollen alle Zellen der Spalte A die Daten enthalten (Bsp.: A1-A110 sind mit Daten gefüllt, Liste wächst aber permanent) markiert und ins Tabellenblatt "gesamt" in die Spalte A (Bsp.: demnach ab A221-A331) angehängt/kopiert werden.
Schritt 3 = Im Tabellenblatt "gesamt" sollen nun alle Zellen der Spalte A die Daten enthalten (Bsp.: A1-A331) markiert, danach alle vorhanden Duplikate entfernt werden und die Spalte A aufsteigend sortiert werden. Im Endeffekt sollte ich dann wenn z.B.: 10 Duplikate herausgefiltert worden sind, 320 Zellen mit Werten erhalten.
Weitere Voraussetzung wäre wenn das Makro ausgeführt wird, ersteinmal die Spalte A im Tabellenblatt "gesamt" zu löschen da sich die Liste auch verkleinern kann und keine alten Daten erhalten bleiben sollen.
Ich hoffe Ihr habt einen Tipp für mich dieses umzusetzen.
Vielen Dank und Gruß Tom

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten zusammenfügen
07.07.2005 09:09:15
Harald
Moin Tom,
hier mein Lösungsvorschlag.A1 in Blatt 3 bleibt frei für z.B. eine Überschrift

Sub test()
Dim iRow As Integer, iRowL As Integer, n As Integer, x As Integer, e As Integer
Dim z
Application.ScreenUpdating = False
'Blatt 3 Inhalte löschen A2 bis A Letzte
Sheets(3).Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
'Zähler festlegen
n = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
x = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
z = 2
'von Blatt 1 nach Blatt 3
For i = 1 To n
Sheets(3).Cells(z, 1) = Sheets(1).Cells(i, 1)
z = z + 1
Next i
Set z = Nothing
'von Blatt 2 nach Blatt 3
z = Sheets(3).Cells(Rows.Count, 1).End(xlUp).Row + 1
For e = 1 To x
Sheets(3).Cells(z, 1) = Sheets(2).Cells(e, 1)
z = z + 1
Next e
'doppelte löschen
iRowL = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For iRow = iRowL To 2 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(iRow, 1)) > 1 Then
Rows(iRow).Delete
End If
Next iRow
'sortieren
UsedRange.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub

Gruß und viel Erfolg
Harald
Rückmeldung wäre nett
Anzeige
uuupss, was vergessen
07.07.2005 09:11:19
Harald
Hi nochmal.
Ich hab den Code im Blattmodul von Blatt 3 geschrieben.
Damit er funzt, solltest Du ihn auch ins Blattmodul 3 kopieren
Harald
Nachtrag
07.07.2005 10:43:23
Tom
Hallo Harald,
erstmal Danke für Deine umgehende Hilfe. Ein kleines Problem hätte ich noch bzw. weiß ich nicht wo ich die Anpassungen machen muss. Hier die korrekten Daten um es auch testen zu können. Leider hatte ich die gestern nicht zur Hand:
Aus dem Tabellenblatt "daten_1" sollen die Werte ab B7-B? kopiert werden.
Aus dem Tabellenblatt "daten_2" sollten die Werte ab B5-B? kopiert/angehängt werden.
Im Tabellenblatt "gesamt" sollten dann alle Werte ab der Zelle B3-B? eingetragen sein.
Ich hoffe die Korrektur ist kein Problem für Dich. Danke für Deine Mühe...
Gruß Tom
Anzeige
AW: Nachtrag
07.07.2005 10:59:28
Harald
Hi Tom,
kurze Erläuterung, falls späterhin Änderungen fällig sind und Du dich mal selbst versuchen möchtest.
cells(Zeile, Spalte) d.h. B1 entspricht cells(1, 2)
letzte nichtleere in Spalte B (von unten)
cells(rows.count, 2).end(xlup).row

Sub test()
Dim iRow As Integer, iRowL As Integer, n As Integer, x As Integer, e As Integer
Dim z
Application.ScreenUpdating = False
'Blatt 3 Inhalte löschen B3 bis A Letzte
Sheets(3).Range("B3:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Sheets(3).Range("B2") = "Gesamt"
'Zähler festlegen
n = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
x = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
z = 3
'von Blatt 1 nach Blatt 3
For i = 7 To n
Sheets(3).Cells(z, 2) = Sheets(1).Cells(i, 2)
z = z + 1
Next i
Set z = Nothing
'von Blatt 2 nach Blatt 3
z = Sheets(3).Cells(Rows.Count, 2).End(xlUp).Row + 1
For e = 5 To x
Sheets(3).Cells(z, 2) = Sheets(2).Cells(e, 2)
z = z + 1
Next e
'doppelte löschen
iRowL = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For iRow = iRowL To 2 Step -1
If WorksheetFunction.CountIf(Columns(2), Cells(iRow, 2)) > 1 Then
Rows(iRow).Delete
End If
Next iRow
'sortieren
Range("B2:B" & iRowL).Sort Key1:=Range("B3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub

Viel Erfolg
Harald
Anzeige
AW: Nachtrag
07.07.2005 15:42:08
Tom
Hallo Harald,
Danke für Deine schnelle Hilfe, funktioniert nun einwandfrei. Eine Frage hätte ich jedoch noch...
Wäre es denn möglich das die Datenzellen die von "daten_1 + daten_2" nach "gesamt" kopiert werden ihre Hintergrundfarbe beibehalten? Bestimmte Zellen in "daten_1 + daten_2" haben eine besondere Hintergrundfarbe die auch dann auf dem Tabellenblatt "gesamt" ersichtlich sein sollte. Des Weiteren benötige ich noch einen Tipp wie ich dann die neuerstellten Daten in "gesamt" formatiert ausgeben kann (Arial, 10pt, jede Zeile einen Rahmen usw.).
Danke und Gruß Tom
AW: Nachtrag
07.07.2005 15:55:13
Harald
Hi,
teilgetestet hab ich mal den interior.colorindex beigefügt. Bin mittlerweile zuhause und dein "Nachbau" schlummert im Firmen-PC.
Die Formatierung der "gesamt"-Splate kannst Du dir per Rekorder aufzeichnen und mal versuchen, dass dann einzubauen.
Morgen früh in der Firma schau ich dann mal wieder rein.

Sub test()
Dim iRow As Integer, iRowL As Integer, n As Integer, x As Integer, e As Integer
Dim z
Application.ScreenUpdating = False
'Blatt 3 Inhalte löschen B3 bis A Letzte
Sheets(3).Range("B3:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Sheets(3).Range("B2") = "Gesamt"
'Zähler festlegen
n = Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
x = Sheets(2).Cells(Rows.Count, 2).End(xlUp).Row
z = 3
'von Blatt 1 nach Blatt 3
For i = 7 To n
Sheets(3).Cells(z, 2) = Sheets(1).Cells(i, 2)
Sheets(3).Cells(z, 2).interior.colorindex = Sheets(1).Cells(i, 2).interior.colorindex
z = z + 1
Next i
Set z = Nothing
'von Blatt 2 nach Blatt 3
z = Sheets(3).Cells(Rows.Count, 2).End(xlUp).Row + 1
For e = 5 To x
Sheets(3).Cells(z, 2) = Sheets(2).Cells(e, 2)
Sheets(3).Cells(z, 2).interior.colorindex = Sheets(2).Cells(e, 2).interior.colorindex
z = z + 1
Next e
'doppelte löschen
iRowL = Cells(Cells.Rows.Count, 2).End(xlUp).Row
For iRow = iRowL To 2 Step -1
If WorksheetFunction.CountIf(Columns(2), Cells(iRow, 2)) > 1 Then
Rows(iRow).Delete
End If
Next iRow
'sortieren
Range("B2:B" & iRowL).Sort Key1:=Range("B3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Application.ScreenUpdating = True
End Sub

Viel Erfolg
Harald
Anzeige
AW: Nachtrag
08.07.2005 11:14:48
Tom
So nun passt alles. Vielen Dank für die fachmännische Hilfe.
Mfg Tom
Danke für Rückmeldung ;-) o.w.T
08.07.2005 11:23:23
Harald
Gruß
Harald

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige