Ich suche nach einem Makro welches volgende Aufgaben übernehmen kann:
Basis sind 2 Excel sheets in einem Workbook.
In der Spalte A beider sheets sind eindeutige id’s.
Nun möchte ich, dass das Makro die beiden Spalten „A“ vergleicht und jeweils gleiche Werte auf die gleiche Zeile setzt. Werte die nur in sheet1 „A“ oder nur in sheet2 „A“ vorkommen, sollen unterhalb stehen.
Wichtig dabei ist, dass die Spalten „B:M“ auch mit verschoben werden.
Ich hoffe, dass mir jemand dabei helfen kann.
Für alle hilfreichen Tips und Anregungen danke ich euch!
Hallo,
muss es unbedingt ein Makro sein? Sowas macht man normaler Weise schnell und sauber mit einem Pivot-Table.
Allerdings frage ich da immer meine Kollegin…
Welche Tabelle ist die Mastertabelle? Wie setzen sich die
IDs zusammen (nenne ein Bsp. die in deiner Tabelle
vorkommen)und sollen die IDs aufsteigend sortiert werden?
Du hast Glück! Ich habe auf Arbeit gerade etwas ähnliche
programmiert, so hab ich mal schnell was
zusammengetippst. Vielleicht
nutzt es dir ja was bzw kannst du es noch anpassen.
Wenn du noch Hilfe brauchen solltest, dann schreib
einfach noch mal.
LG OVM
Option Explicit
Sub Sortieren()
Dim cZeile As Integer
Dim gefundeneZeile As Integer
'Arbeitsblätter einfügen, für Ausgabe
Do Until ActiveWorkbook.Sheets.count >= 3
Sheets.Add after:=Sheets(Sheets.count)
Loop
Sheets(3).Cells(1, 1).Value = „Doppelte Zeilen“
'Alle Zeilen in Sheet 1 auf Partner prüfen
For cZeile = 1 To Sheets(1).UsedRange.Rows.count
'sucht in Blatt zwei nach dem Partner
gefundeneZeile = suchen(Sheets(1).Cells(cZeile,
1).Value)
'schreibt die Zeilen mit gleicher ID in Blatt 3
jeweils untereinander
If gefundeneZeile 0 Then
Sheets(1).Rows(cZeile).Copy
Sheets(3).Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
Sheets(2).Rows(gefundeneZeile).Copy
Sheets(3).Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
'Versteckt die Zeilen dann, sodass nur noch die
nicht doppelten sichtbar sind
Sheets(1).Rows(cZeile).Hidden = True
Sheets(2).Rows(gefundeneZeile).Hidden = True
End If
Next cZeile
End Sub
Function suchen(gesuchter As String) As Integer
Dim cSuchzeile As Integer
Dim gefunden As Boolean
gefunden = False
For cSuchzeile = 1 To
Sheets(2).UsedRange.Rows.count
If Sheets(2).Cells(cSuchzeile, 1).Value =
gesuchter Then
suchen = cSuchzeile
gefunden = True
Exit For
End If
wenn man eine Frage stellt, und einen Tag später gleich eine Lösung bekommt, dann kann
man auch mal schreiben, ob es geklappt hat und sich zur Not auch mal bedanken. Dann
freuen sich auch die Helfer!