Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

doppelte Einträge suchen und rückgabe

Betrifft: doppelte Einträge suchen und rückgabe von: Urs Bollliger
Geschrieben am: 07.08.2014 15:22:42

hallo zusammen
ich bräuchte nach langer Zeit wiedermal eure Hilfe.
ich habe mir das Makro "Dubletten" von hier geholt.
Läuft super!

nun möchte ich anstatt ein "M" als Rückgabewert den Registernamen.

ich hoffe, ihr könnt mir helfen, sonst suche ich mich durch die ganz Mappe

Gruss aus der Schweiz
Urs

  

Betrifft: Du musst schon bissel was mitteilen,... von: Matze Matthias
Geschrieben am: 07.08.2014 15:44:20

Hallo Urs,
man sollte zumindest erhoffen das man den Aufbau des Makros hier postet.
Ich suche mir das jetzt nicht aus der Recherche, Andere Helfer bestimmt auch nicht.
Die Aufgabenstellung wann das "M" bzw Registername zurückgegeben wird ist doch das ausschlaggebende.

Werde vermutlich mit der Aufgabe überfordert sein, schauen wir mal

Gruß Matze


  

Betrifft: AW: Du musst schon bissel was mitteilen,... von: Urs Bollliger
Geschrieben am: 07.08.2014 15:45:59

hallo Matze.
hier das Makro

Sub Dubletten()
' Durchsucht eine Spalte in allen Tabellen der Mappe nach Mehrfacheinträgen
Spalte = 9 'Spalte die durchsucht werden soll
SpalteM = 8 'Spalte für Markierung der Mehrfacheinträge ("M" wird eingetragen)
Zeile1 = 6 'Zeile in der in jeder Tabelle mit dem Vergleich begonnen werden soll
Farbe = 15 ' Colorindex für Füllfarbe bei Mehrfacheinträgen, 3 = Rot
With ActiveWorkbook
For i = 1 To .Sheets.Count
For ZeileI = Zeile1 To .Sheets(i).Cells(.Sheets(i).Rows.Count, Spalte).End(xlUp).Row
'Bereits markierte Zeile überspringen
If .Sheets(i).Cells(ZeileI, SpalteM) = "M" Then GoTo NextI
Wert = .Sheets(i).Cells(ZeileI, Spalte)
'Vergleich mit restlichen Zellen
For j = i To .Sheets.Count
'Startzeile für Vergleichstabelle setzen
If i = j Then
' steht Wert in der letzten Zeile des Blattes i dann wird im nächten Blatt weitergesucht
If ZeileI = .Sheets(i).Cells(.Sheets(i).Rows.Count, Spalte).End(xlUp).Row Then Exit For
ZeileJStart = ZeileI + 1
Else
ZeileJStart = Zeile1
End If
For ZeileJ = ZeileJStart To .Sheets(j).Cells(.Sheets(j).Rows.Count, Spalte).End(xlUp).Row
'Prüfung ob Zeile bereits markiert als Mehrfacheintrag
If .Sheets(j).Cells(ZeileJ, SpalteM) = "M" Then GoTo NextJ
'Wertevergleich
If Wert = .Sheets(j).Cells(ZeileJ, Spalte) Then
.Sheets(j).Cells(ZeileJ, SpalteM) = "M"
.Sheets(j).Rows(ZeileJ).Interior.ColorIndex = Farbe
Mehrfach = True
End If
NextJ:
Next ZeileJ
Next j
'1. Zeile mit Wert auch markieren
If Mehrfach = True Then
.Sheets(i).Cells(ZeileI, SpalteM) = "M"
.Sheets(i).Rows(ZeileI).Interior.ColorIndex = Farbe
Mehrfach = False
End If
NextI:
Next ZeileI
Next i
End With
' Markierungen in SpalteM entfernen?
If MsgBox("Markierung 'M' in Spalte " & SpalteM & " entfernen?", vbYesNo + vbQuestion, _
"Mehrfacheinträge suchen") = vbYes Then
ActiveWorkbook.Sheets.Select
Columns(SpalteM).Select
Selection.ClearContents
Range("A1").Select
Sheets(1).Select
End If
End Sub



  

Betrifft: Bitte Profi drüber schauen,... Aufgabe noch unklar von: Matze Matthias
Geschrieben am: 07.08.2014 15:59:01

Hallo Urs,

ich bin raus , wird einer der Profis drüber schauen.

In dem Makro wird in ALLEN Tabellen in einer BESTIMMTEN Spalte nach doppelten Wert gesucht
und in einer WEITEREN Spalte mit einem "M" markiert


WANN bzw WAS genau soll denn jetzt passieren?


  

Betrifft: AW: Bitte Profi drüber schauen,... Aufgabe noch unklar von: Urs Bollliger
Geschrieben am: 07.08.2014 16:22:37

Hallo Matze

wie du ja schreibst:
"In dem Makro wird in ALLEN Tabellen in einer BESTIMMTEN Spalte nach doppelten Wert gesucht
und in einer WEITEREN Spalte mit einem "M" markiert"

anstatt das "M" möchte ich die Rückgabe, in welchem Tabellenblatt das Duplikat gefunden wurde.


  

Betrifft: Bitte Profi drüber schauen,...Offen! von: Matze Matthias
Geschrieben am: 07.08.2014 16:31:09

Nur als "offen" deklariert damit das bearbeitet wird!


  

Betrifft: Name von: Christian
Geschrieben am: 07.08.2014 17:21:08

Hallo Urs,

bin zwar kein Profi, aber wenn ich Dich richtig verstanden habe, sollte es eigentlich mit
.Sheets(i).Name bzw. .Sheets(j).Name anstatt "M" klappen.

MfG Christian


  

Betrifft: AW: Name von: Urs Bollliger
Geschrieben am: 07.08.2014 17:33:11

Hallo Christian
ich bin auch kein Profi in VBA, drum habe ich keine Ahnung, wo ich das ersetzen muss :-)

Gruss


  

Betrifft: AW: Name von: Christian
Geschrieben am: 07.08.2014 17:47:52

Hallo Urs,

aber Lesen klappt? ;-)

Überall im Code, wo ein "M" auftaucht, dieses gegen .Sheets(i).Name bzw. .Sheets(j).Name austauschen,
je nachdem wo gesucht wird.

Bisschen Mitarbeit ist nicht sooo schwierig, zumal als Excel-Profi doch eine Gewisse Logik-Kenntnis da ist ;-)

MfG Christian


  

Betrifft: AW: Name von: Urs Bollliger
Geschrieben am: 07.08.2014 18:41:20

nun ja, dem ist so. :-)

klappt leider nicht so, weil jetzt einfach der eigene Tabellennamen in die Zelle geschrieben wir und nicht der Tabellennamen, wo das Duplikat ist.


  

Betrifft: So geimeint ? offen da keine Lösung von: Matze Matthias
Geschrieben am: 07.08.2014 19:56:57

Hallo Urs,..

na mach endlich mal Butter bei die Fische,..

WAS willst du erreichen:
Tabelle 1 Zelle A1 und Zelle A20 = 100 somit doppelter Wert in Spalte X soll nun Tabelle 1 stehen?
Das geht nur mit einer Tabelle (DER VERGLEICH) da man das nicht zuordnen kann .

Das Makro müsste jedes Blatt für sich behandeln!

Außerdem sollte dieses mit Formel und bedingter Formatierung ebenso möglich sein.

Gruß Matze


  

Betrifft: AW: Du musst schon bissel was mitteilen,... von: Frank
Geschrieben am: 07.08.2014 22:30:35

Hoi Urs,

wenn ich's richtig durchschaut habe findest Du hier



die Zeile, in der die Änderung gemacht werden müsste.

Grüsse,
Frank


  

Betrifft: AW: Du musst schon bissel was mitteilen,... von: Urs Bollliger
Geschrieben am: 11.08.2014 21:15:16

Hallo Frank
Danke, du bist nah dran.

habe eine File upgeloadet.
https://www.herber.de/bbs/user/92023.xlsm
da könnt ihr mal gucken.
in den hinteren Register funktioniert das mit der Rückgabe, aber in den vorderen nicht.

Gruss Urs


  

Betrifft: AW: Du musst schon bissel was mitteilen,... von: Frank
Geschrieben am: 11.08.2014 22:09:37

Hallo Urs,

da ich XL2000 benutze, kann ich xlsm-Dateien nicht korrekt öffnen. Zum Glück gibt es aber LibreOffice. Da sehe ich im Code (der hier natürlich nicht ausführbar/zu testen ist), dass oberhalb der von mir markierten Stelle ein Abschnitt existiert "'Bereits markierte Zeile überspringen". Der tut auch genau das - in vorhergehenden Durchläufen mit "M" markierte Zeilen überspringen.
Es könnte sinnvoll sein, in einer Kopie der Datei alle "M" zu löschen und das Makro nochml laufen zu lassen. Sieht das dann besser aus, müsste die Zeile

If .Sheets(i).Cells(ZeileI, SpalteM) = "M" Then GoTo NextI

ersetzt werden durch
If not (isempty (.Sheets(i).Cells(ZeileI, SpalteM))) Then GoTo NextI
Vorsicht, das ist nicht getestet...

Grüsse,
Frank


 

Beiträge aus den Excel-Beispielen zum Thema "doppelte Einträge suchen und rückgabe"