tahsinanarat
Altın Üye
- Katılım
- 14 Mart 2005
- Mesajlar
- 2,181
- Excel Vers. ve Dili
- Ofis 2019 Türkçe
2003 excel dosyasında hazırladığım makro b1 hücresinde yazdığım kriteri arama yaparak listeliyordu, ancak 2010 excele geçtiğimde bu tür makroların çalışmadığını fark ettim, bilgisi olan arkadaşların yardımcı olmasını istiyorum.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AYIR() As String
Dim x As Long, Y As Integer, SAY As Integer
On Error Resume Next
If Intersect(Target, [B1]) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
If Target <> Empty Then
Target.Activate
With Range("Z3:Z" & [a65536].End(3).Row)
.Formula = "=B3 & "" "" & C3 & "" "" & D3"
.Value = .Value
End With
AYIR = Split(Target, " ")
For x = 3 To Range("A1").CurrentRegion.Rows.Count
SAY = 0
For Y = 0 To UBound(AYIR())
If UCase(Replace((Replace(Cells(x, "Z"), "i", "İ")), "ı", "I")) Like "*" & UCase(Replace((Replace(AYIR(Y), "i", "İ")), "ı", "I")) & "*" Then SAY = SAY + 1
Next
If SAY <> (UBound(AYIR()) + 1) Then
Cells(x, "Y") = False
Else
Cells(x, "Y") = True
End If
Next
[a2].AutoFilter Field:=25, Criteria1:=True
Application.ScreenUpdating = True
Rows("2:2").RowHeight = 19.5
'MsgBox "İşleminiz tamamlanmıştır.", vbInformation
Else
If ActiveSheet.AutoFilterMode = True Then [A3].AutoFilter
[Z3:Z65536].ClearContents
Application.ScreenUpdating = True
End If
Calculate
End Sub
