• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

2003 de hazırladığım makro 2010 da çalışmadı

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
 
Merhaba,

Sorunuz çok genel olmuş. Kodlarınız hangi satırda hata veriyor.

Mesela "On Error Resume Next" satırı kullanılmış. Bu satır genelde hataları görmemizi engeller. Bu satır yerine kodların hata veren bölümlerine hata kontrolleri eklenebilir.

Eğer kodlar hiç tepki vermiyorsa ya yanlış bölüme uygulamışsınızdır. Ya da makrolar etkin değildir.
 
Sn. korhan hocam On error resume next satırını kaldırıp denememe rağmen herhangi bir hata mesajı almıyorum. Kodlar çalışmış görünüyor ancak, aranan kriterler süzülmüyor, B1 hücresine yazdığım kelime B,C ve D sutunlarında bulunan değerlerden hangi satırlarda var ise o satırlar süzülüp diğer satırlar gizleniyor. 2003 excel versiyonunda bu görevi yapıyor, ancak 2010 da yapıyormuş gibi görünsede herhangi bir süzülme olayı gerçekleşmiyor.
Ekte 2003 versiyonunda hazırlanmış örnek dosyayı gönderiyorum.
 

Ekli dosyalar

Aşağıdaki şekilde denediğimde olumlu sonuç aldım.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AYIR() As String
    Dim x As Long, Y As Integer, SAY As Integer
    If Intersect(Target, [B1]) Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    
    On Error Resume Next
    If ActiveSheet.AutoFilterMode Then ShowAllData
    On Error GoTo 0
    
    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") = ""
            Else
            Cells(x, "Y") = "X"
            End If
        Next
        
        [a2].AutoFilter Field:=25, Criteria1:="X"
        Application.ScreenUpdating = True
        Rows("2:2").RowHeight = 19.5
    Else
        If ActiveSheet.AutoFilterMode = True Then [A3].AutoFilter
        [Z3:Z65536].ClearContents
        Application.ScreenUpdating = True
    End If
    Calculate
End Sub
 
Sn. Korhan hocam, ilgi ve alakanız için çok teşekkür ediyorum, iki kod arasındaki farklılıkları inceledim,
ilaveten;
On Error Resume Next
If ActiveSheet.AutoFilterMode Then ShowAllData
On Error GoTo 0

gelmiş olup, True değerinin iki tanesi de "x" şeklinde değiştini gördüm, sebebini anlamasamda sonuç tamam :) tekrar teşekkürler.
 
Geri
Üst