Mehrfacheinträge ermitteln, markieren und Userform

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Nepumuk
Klar. Irgendwas vergesse ich immer. ;-)
Also in der 1. Spalte stehen 10stellige Nummern (Versicherungsnummern). Nächste Spalte Name. Danach Vorname. Nächste Spalte eine 13stellige Nr. (Fall-Nr.).
Wenn ich also in der 1. Spalte eine Nr. anklicke/auswähle muss ich wissen, ob es zu dieser Nr. noch mehr Zeilen in der Datei gibt.
Damit weiß ich dann, dass dieser eine Versicherte noch mehr Fälle hat, die ich mir ansehen muss.
Sortieren bringt nichts, da ich IMMER nach dem Fall-Datum (von alt nach jung) arbeiten muss. Ist leider so.
Die ältesten Fälle zuerst - wegen Verjährung.
Wenn ich aber sehen könnte, dass die Person noch mehr Fälle hat, kann ich gleich alles in einem abarbeiten und muss nicht ggf. 5 Briefe innerhalb von 2 Wochen schicken.
Ich hoffe ich habe es einigermaßen darstellen können.
Gruß und Danke
Werner

With Worksheets(1).Range("a1:a500") Set c = .Find(ActiveCell.value, lookin:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do c.Value = ActiveCell.value Set c = .FindNext(c) MsgBox "Zeile " & c.row Loop While Not c Is Nothing And c.Address firstAddress End If End With

Hallo Werner,
das würde ich so machen

Option Explicit
'   Ich möchte in einem Blatt Mehrfacheinträge ermitteln, markieren und
'   diese dann in einem Userform(ular) darstellen lassen.
'   Die Bearbeitung ist wie folgt vorgesehen:
'   Man klickt eine Zelle in (z. B.) Spalte A an.
'   Dann soll das Makro nachschauen, ob es diesen Wert im Blatt noch öfter gibt.
'   Wenn ja, sollen alle Fundstellen gekennzeichnet und in einem Userform dargestellt werden.
Public Sub Doppelte_ausweisen()
Dim rZelle    As Range
Dim sFundst   As String
Dim sText     As String
Dim rDoppelt  As Range
With ThisWorkbook.Worksheets("Tabelle1").Columns(ActiveCell.Column)
Set rZelle = .Find(ActiveCell.Value, LookAt:=xlWhole, LookIn:=xlValues, After:=.Cells(. _
Cells.Count))
If Not rZelle Is Nothing Then
sFundst = rZelle.Address
Do
If rDoppelt Is Nothing Then
Set rDoppelt = .Range("A" & rZelle.Row)  ' betrifft nur die Zelle
sText = rZelle.Row
Else
'Set rDoppelt = Union(rDoppelt, Rows(rZelle.Row))         ' betrifft die ganze  _
Zeile
Set rDoppelt = Union(rDoppelt, .Range("A" & rZelle.Row)) ' betrifft nur die  _
Zelle
sText = sText & vbLf & rZelle.Row
End If
Set rZelle = .Cells.FindNext(rZelle)
Loop While Not rZelle Is Nothing And rZelle.Address  sFundst
End If
End With
If InStr(sText, vbLf) > 0 Then
rDoppelt.Select      ' den Inhalt der Zeile (Zelle) färben
MsgBox "Der Begriff  """ & ActiveCell.Value & """  steht in den Zeilen" & vbLf & vbLf &  _
sText, _
64, "   Information für " & Application.UserName
Else
MsgBox "Der Begriff  """ & ActiveCell.Value & """  wurde nur einmal gefunden.", _
64, "   Hinweis für " & Application.UserName
End If
Set rDoppelt = Nothing
Set rZelle = Nothing
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

Mehrfacheinträge ermitteln, markieren und Userform

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrfacheinträge ermitteln, markieren und Userform

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread