VBA Suche mit mehreren Ergebnissen

Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Target.Address = "$D$5" Then Dim rngSearchISIN As Range If IsEmpty(Range("D5").Value) Then Range("D5").Select MsgBox "Bitte ISIN des Anlageguts eingeben oder, falls nicht vorhanden, neue Anlage _ erstellen.", vbInformation Else Set rngSearch = Columns(5).Find(What:=Range("D5").Value, LookIn:=xlValues, LookAt:= _ xlWhole, MatchCase:=True) If Not rngSearch Is Nothing Then rngSearch.Select Application.Goto ActiveCell.EntireRow, True ActiveCell.Offset(0, 4).Select Set rngSearch = Nothing Else MsgBox "ISIN " & Range("D5").Value & " nicht vorhanden.", vbExclamation, "Hinweis" Range("D5").Select End If End If End If Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Clara,
nein. Die suche beginnt nach der aktiven Zelle, also D5 oder D6 es wird also bei erneuter Suche die erste Fundstelle wieder als erstes gefunden. Test mal mit einfärben der aktuellen Fundstelle, ist kein großer Aufwand:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rngSearch As Range
    Dim strFirstAddress As String
    Dim blnMultiFound As Boolean

    If Target.Address = "$D$5" Then
        If IsEmpty(Target.Value) Then
            Target.Select
            MsgBox "Bitte ISIN des Anlageguts eingeben oder, falls nicht vorhanden, neue Anlage erstellen.", vbInformation
        Else
            Set rngSearch = Columns(5).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not rngSearch Is Nothing Then
                strFirstAddress = rngSearch.Address
                Do
                    rngSearch.Interior.Color = vbGreen
                    rngSearch.Select
                    If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                        rngSearch.Interior.Pattern = xlPatternNone
                        Exit Do
                    End If
                    rngSearch.Interior.Pattern = xlPatternNone
                    Set rngSearch = Columns(5).FindNext(After:=rngSearch)
                    If rngSearch.Address <> strFirstAddress Then
                        blnMultiFound = True
                    Else
                        If blnMultiFound Then
                            If MsgBox("Letzte Fundstelle. Nochmal von vorne?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
                        Else
                            Call MsgBox("Keine weiteren Fundstellen.", vbExclamation, "Hinweis")
                            Exit Do
                        End If
                    End If
                Loop
                Set rngSearch = Nothing
            Else
                MsgBox "ISIN " & Target.Value & " nicht vorhanden.", vbExclamation, "Hinweis"
                Target.Select
            End If
        End If
    End If
End Sub

Gruß
Nepumuk

Hallo Clara,
warum ist dein altes Programm noch drin? Damit funktioniert das einfärben nicht. Das genügt:

Private Sub Worksheet_Change(ByVal Target As Range)

    'ISIN

    Dim rngSearch2 As Range
    Dim strFirstAddress As String
    Dim blnMultiFound As Boolean

    If Target.Address = "$D$5" Then
        If IsEmpty(Target.Value) Then
            Target.Select
            MsgBox "Bitte ISIN des Anlageguts eingeben oder, falls nicht vorhanden, neue Anlage erstellen.", vbInformation
        Else
            Set rngSearch2 = Columns(5).Find(What:=Target.Value, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True)
            If Not rngSearch2 Is Nothing Then
                strFirstAddress = rngSearch2.Address
                Do
                    rngSearch2.Interior.Color = vbGreen
                    rngSearch2.Select
                    If MsgBox("Weitersuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then
                        rngSearch2.Interior.Pattern = xlPatternNone
                        Exit Do
                    End If
                    rngSearch2.Interior.Pattern = xlPatternNone
                    Set rngSearch2 = Columns(5).FindNext(After:=rngSearch2)
                    If rngSearch2.Address <> strFirstAddress Then
                        blnMultiFound = True
                    Else
                        If blnMultiFound Then
                            If MsgBox("Letzte Fundstelle. Nochmal von vorne?", vbQuestion Or vbYesNo, "Abfrage") = vbNo Then Exit Do
                        Else
                            Call MsgBox("Keine weiteren Fundstellen.", vbExclamation, "Hinweis")
                            Exit Do
                        End If
                    End If
                Loop
                Set rngSearch2 = Nothing
            Else
                MsgBox "ISIN " & Target.Value & " nicht vorhanden.", vbExclamation, "Hinweis"
                Target.Select
            End If
        End If
    End If
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

VBA Suche mit mehreren Ergebnissen

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Suche mit mehreren Ergebnissen

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

307 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread