Makro msg für doppelte Einträge

Forumthread: Makro msg für doppelte Einträge

10.05.2016 08:17:45

Sdravi

Hy,
ich hab 6 Mappen
Per Makro möchte ich jetzt prüfen ob alle Einträge
Aus der Tabelle 1 Spalte A nur einmal in den anderen
Tabellen enthalten sind.
Das heißt meine Einträge die in Spalte A stehen muss ich in
andere 5 tabellen verteilen auch in Spalten A dabei dürfen keine
doppeleinträge enthalten sein, Zwischen den Tabellen2 bis Tabelle6.
Dann nur ne msgBox "Alle Einträge aus Tabelle 1 wurden vergeben"
Bei Doppeleinträgen zwischen Tabelle2 bis 6 als beispiel: msgBox "Tabelle3 und Tabelle5 haben
Doppeleinträge"
Mfg

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makro msg für doppelte Einträge

10.05.2016 13:14:47

ChrisL
AW: Makro msg für doppelte Einträge

10.05.2016 16:47:49

Sdravi

AW: Makro msg für doppelte Einträge

10.05.2016 13:14:47

ChrisL

Hi
Viel Spass...

Sub TestMe()
Dim WS1 As Worksheet, WS2 As Worksheet
Dim arSheet() As Variant
Dim iBlatt As Integer, iZeile As Long
Dim tempCounter As Long, tempAnzahl As Long
Dim tempError As String, sError As String
Dim bError As Boolean, bDoppelt As Boolean
Set WS1 = Worksheets("Tabelle1")
arSheet = Array("Tabelle2", "Tabelle3", "Tabelle4", "Tabelle5", "Tabelle6")
For iZeile = 1 To WS1.Cells(WS1.Rows.Count, 1).End(xlUp).Row
tempCounter = 0
tempError = ""
bDoppelt = False
For iBlatt = 0 To UBound(arSheet)
Set WS2 = Worksheets(arSheet(iBlatt))
tempAnzahl = WorksheetFunction.CountIf(WS2.Columns(1), WS1.Cells(iZeile, 1))
If tempAnzahl > 1 Then
tempError = "Wert '" & WS1.Cells(iZeile, 1) & "' ist auf dem Blatt '" & _
WS2.Name & "' doppelt vorhanden."
bDoppelt = True
Exit For
End If
If tempAnzahl = 1 Then
If tempError = "" Then
tempError = "'" & WS2.Name & "'"
Else
tempError = tempError & " und '" & WS2.Name & "'"
End If
tempCounter = tempCounter + 1
End If
Next iBlatt
If bDoppelt Then
sError = sError & Chr(10) & tempError
bError = True
Else
If tempCounter = 0 Then
sError = sError & Chr(10) & "Wert '" & WS1.Cells(iZeile, 1) & "' in Zeile " _
& iZeile & " fehlt."
bError = True
End If
If tempCounter > 1 Then
sError = sError & Chr(10) & "Wert '" & WS1.Cells(iZeile, 1) & "' in Zeile " _
& iZeile & " kommt mehrfach in Blatt " & tempError & " vor."
bError = True
End If
End If
Next iZeile
If bError Then
MsgBox "Folgende Fehler sind aufgetreten:" & sError
Else
MsgBox "Alles OK."
End If
End Sub

cu
Chris

AW: Makro msg für doppelte Einträge

10.05.2016 16:47:49

Sdravi

Hy, das ist ja Klasse.
es funct genau so wie ich es brauche....
Vielen Dank!

Beliebteste Forumthreads (12 Monate)

Makro msg für doppelte Einträge

Forumthread: Makro msg für doppelte Einträge

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread