sutunda çoklu bul

[ildizim]

merhaba,

sutunda aradıgım bulmak için aşagıdaki kodu kullanıyorum fakat c5'de ahmet varsa onu buluyor c20 deki ahmedi göstermiyor ikisinide göstermesi için bu koda nasıl bir ilave yapabiliriz.
Syg.

Private Sub TextBox1_Change()
On Error Resume Next
SONUC2 = TextBox1.Value
Set FC2 = Range("C2:C65000").Find(What:=SONUC2)
Application.Goto Reference:=Range(FC2.Address), _
Scroll:=False

End Sub

 

[bedersu]

Şu şekilde deneyin:

Private Sub TextBox1_Change()
On Error Resume Next

For Each isim In Range("C2:C65000")
If isim = TextBox1.Value Then
adr = adr & "," & isim.Address
End If
adrs = adr
Next isim
Range(Right(adr, Len(adr) - 1)).Select

End Sub

 

[veyselemre]

Linki inceleyin.

 

[Ali]

merhaba,

sutunda aradıgım bulmak için aşagıdaki kodu kullanıyorum fakat c5'de ahmet varsa onu buluyor c20 deki ahmedi göstermiyor ikisinide göstermesi için bu koda nasıl bir ilave yapabiliriz.
Syg.

Kodlar Haluk Bey'e aittir.

Sub FindExactMatch()
    Dim MyStr As String, InfoMsg As String
    Dim Rng1 As String, LookupValue As String
    Dim MyQ As VbMsgBoxResult
    Dim FoundRng As Variant
    MyStr = Trim(Application.InputBox("Aranacak kelime yada sayısal değeri giriniz", "Arama..."))
        If Not MyStr = "False" Then
            Set FoundRng = Cells.Find(MyStr, LookIn:=xlValues, LookAt:=xlPart)
            If Not FoundRng Is Nothing Then
                Rng1 = FoundRng.Address
                FoundRng.Select
ResumeSub2:
                If Right(FoundRng.Value, 1) <> " " Then LookupValue = FoundRng.Value & " "
                MyData = Split(LookupValue, " ", , vbTextCompare)
                    For i = LBound(MyData) To UBound(MyData)
                        If MyData(i) = MyStr Then
                            InfoMsg = "Aranan sayı yada kelime " & FoundRng.Address(False, False) _
                            & " hücresindedir ." _
                            & vbCrLf & vbCrLf & "Hücre içeriği :" _
                            & vbCrLf & vbCrLf & FoundRng.Value & vbCrLf _
                            & vbCrLf & "Devam edecekmisiniz ?"
                              MyQ = MsgBox(InfoMsg, vbInformation + vbYesNo, "Arama sonucu...")
                            If MyQ = vbYes Then GoTo ResumeSub1:
                            Exit Sub
                        End If
                    Next
            Else
            MsgBox "", vbInformation, "Arama sonucu..."
            Exit Sub
        End If
ResumeSub1:
    Set FoundRng = Cells.FindNext(FoundRng)
        If Rng1 = FoundRng.Address Then
            MsgBox "Başka veri yoktur!", vbInformation, "Arama Sonucu..."
            Exit Sub
        End If
    FoundRng.Select
    GoTo ResumeSub2:
    End If
    Set FoundRng = Nothing
End Sub