- Katılım
- 1 Mart 2005
- Mesajlar
- 22,248
- Excel Vers. ve Dili
-
Win7 Home Basic TR 64 Bit
Ofis-2010-TR 32 Bit
Rica ederim.tekrar çok teşekkür ederim hocam
iyi çalışmalar.
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Rica ederim.tekrar çok teşekkür ederim hocam
dosyanızabir bakarmısınız?arkadaşlar yardımcı olabilecek kimse yok mu ?
Sub arama()
Dim i As Long, a As Long, k As Byte, deg As Variant
Liste.RowSource = ""
ReDim myarr(1 To [B][COLOR="Red"]40[/COLOR][/B], 1 To 1)
For i = 2 To Cells(65536, "B").End(xlUp).Row
If LCase(Replace(Replace(Cells(i, "b").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN40.Value & "*") _
And LCase(Replace(Replace(Cells(i, "t").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN41.Value & "*") _
And LCase(Replace(Replace(Cells(i, "u").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN42.Value & "*") _
And LCase(Replace(Replace(Cells(i, "x").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN43.Value & "*") _
And LCase(Replace(Replace(Cells(i, "y").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN44.Value & "*") _
And LCase(Replace(Replace(Cells(i, "ak").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN45.Value & "*") _
And LCase(Replace(Replace(Cells(i, "al").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN46.Value & "*") _
And LCase(Replace(Replace(Cells(i, "am").Value, "I", "ı"), "İ", "i")) Like LCase(ALAN47.Value & "*") Then
a = a + 1
ReDim Preserve myarr(1 To [B][COLOR="red"]40[/COLOR][/B], 1 To a)
For k = 1 To [B][COLOR="red"]40[/COLOR][/B]
myarr(k, a) = Cells(i, k).Value
Next k
If a = 1 Then
deg = Cells(i, 10).Value
ElseIf Cells(i, 10).Value < deg Then
deg = Cells(i, 10).Value
End If
End If
Next i
If a > 0 Then Liste.Column = myarr
Erase myarr
End Sub