Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
1492to1496
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
Inhaltsverzeichnis

Makro msg für doppelte Einträge

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
Anzeige
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

Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige