Makro: Daten zusammenführen

Hallo,
ich versuche mich gerade in Markos, da ich gerne folgendes erstellen möchte:
Eine Excel-Mappe bestehend aus 5 Excel-Worksheets. Worksheets 1 bis 4 sind Auflistungen von Personen (Vorname, Name, Alter, Geschlecht)
In Worksheet 5 würde ich gerne mittels eines Buttons alle Personen zusammenführen (auflisten) ohne dabei doppelte mitzunehmen.
Es sollen alle Werte aus den Worksheets 1 bis 4 vergleichen werden und sobald es eine Übereinstimmung bei allen Merkmalen (Vorname, Name, Alter, Geschlecht) gibt, so soll die Person nur einmal im Worksheet 5 gelistet werden.
Könnte mir jemand hierbei helfen? Beispiel Excel zu finden: https://www.herber.de/bbs/user/154005.xlsx">https://www.herber.de/bbs/user/154005.xlsx">https://www.herber.de/bbs/user/154005.xlsx
Vielen Dank.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hey,
da meine Excel eine Beispieldatei war, kommt beim kopieren in die Originaldatei folgende Fehlermeldung bei der letzten Zeile:
Sheets(lstrName).Range("A9:D" & 9 + UBound(larMember, 2)) = WorksheetFunction.Transpose(larMember)
Hintergrund noch, neben den bekannten Excel-Blättern existieren noch weitere. Hier hab ich die Funktion oben wie folgt geändert:


Sub Zusammenfuehren()
Dim lshNotAll As Worksheet
Dim lloRow As Long
Dim larMember(), liIdx As Integer, lboExist As Boolean
Dim lloNew As Long, lstrName As String
ReDim larMember(3, 0)
For Each lshNotAll In Sheets
 If lshNotAll.Name = "Modul*" Then
For lloRow = 12 To lshNotAll.Cells(lshNotAll.Rows.Count, 1).End(xlUp).Row
For liIdx = 0 To UBound(larMember, 2)
If larMember(0, liIdx) = lshNotAll.Range("A" & lloRow).Value And _
larMember(1, liIdx) = lshNotAll.Range("B" & lloRow).Value And _
larMember(2, liIdx) = lshNotAll.Range("C" & lloRow).Value And _
larMember(3, liIdx) = lshNotAll.Range("D" & lloRow).Value Then
lboExist = True
Exit For
End If
Next
If lboExist = True Then
lboExist = False
Else
larMember(0, UBound(larMember, 2)) = lshNotAll.Range("A" & lloRow).Value
larMember(1, UBound(larMember, 2)) = lshNotAll.Range("B" & lloRow).Value
larMember(2, UBound(larMember, 2)) = lshNotAll.Range("C" & lloRow).Value
larMember(3, UBound(larMember, 2)) = lshNotAll.Range("D" & lloRow).Value
ReDim Preserve larMember(3, UBound(larMember, 2) + 1)
End If
Next
Else
With lshNotAll
lstrName = .Name
lloNew = IIf(.Cells(lshNotAll.Rows.Count, 1).End(xlUp).Row + 1 = 9, 9, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
If lloNew >= 9 And .Range("A9").Value  "" Then
.Range("A9:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).Delete Shift:=xlUp
End If
End With
End If
Next
ReDim Preserve larMember(3, UBound(larMember, 2) - 1)
Sheets(lstrName).Range("A9:D" & 9 + UBound(larMember, 2)) = WorksheetFunction.Transpose(larMember)
End Sub

Die zu durchsuchenden Excelblätter haben eins gemeinsam. Sie fangen alle mit Modul ... an.

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread