Merhaba bul ile arama yaparken benzer verilerin hepsini nasıl bulabiliriz mesela telefon yazdık bütün çalışma sayfasında kaç telefon avr hepsini alt alta sıralasın. yardımlarınızı bekler teşekkürlerimi sunarım
Sub Bul(Sutün As String, TXT As Object)
Dim bak As Range
Dim Sayfa As Integer
If TXT = "" Then
MsgBox "Lütfen bulmak istediğiniz metni yazın..."
Exit Sub
End If
For Sayfa = 1 To ThisWorkbook.Sheets.Count
Sheets(Sayfa).Select
For Each bak In Range(Sutün & "1:" & Sutün & WorksheetFunction.CountA(Range(Sutün & "1:" & Sutün & "65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(TXT.Value, vbUpperCase) Then
Cells(bak.Row, 2).Select
txtsira.Value = ActiveCell.Offset(0, -1).Value
cbDno.Value = ActiveCell.Offset(0, 0).Value
txtcinsi.Value = ActiveCell.Offset(0, 1).Value
txtmiktar.Value = ActiveCell.Offset(0, 2).Value
Exit Sub
End If
Next bak
Next
MsgBox "Bulunamadı"
End Sub
Sub Bul(Sutün As String, TXT As Object)
Dim bak As Range
Dim Sayfa As Integer
If TXT = "" Then
MsgBox "Lütfen bulmak istediğiniz metni yazın..."
Exit Sub
End If
For Sayfa = 1 To ThisWorkbook.Sheets.Count
Sheets(Sayfa).Select
For Each bak In Range(Sutün & "1:" & Sutün & WorksheetFunction.CountA(Range(Sutün & "1:" & Sutün & "65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(TXT.Value, vbUpperCase) Then
Cells(bak.Row, 2).Select
txtsira.Value = ActiveCell.Offset(0, -1).Value
cbDno.Value = ActiveCell.Offset(0, 0).Value
txtcinsi.Value = ActiveCell.Offset(0, 1).Value
txtmiktar.Value = ActiveCell.Offset(0, 2).Value
Exit Sub
End If
Next bak
Next
MsgBox "Bulunamadı"
End Sub
Son düzenleme: