• DİKKAT

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

Şimdiye kadar çalışan makro çalışmıyor.

  • Konbuyu başlatan Konbuyu başlatan m.gur
  • Başlangıç tarihi Başlangıç tarihi
Korhan Ayhan' Alıntı:
Sonradan farkettim..

Önceki mesajimda On Error Resume Next komutunu silip deneme yapınız demiştim.

Kodların içinde "ActiveSheet.ShowAllData" komutu var. Bu satır eğer sayfada filtre yoksa On Error Resume Next satırını sildiğinizde hata verecektir. Bu sebeple kodlara farklı bir sorgu eklemek gerekir.

Dosyanızı paylaşınız hem gerekli düzenlemeyi yapalım hem de deneme yapalım.
Genişletmek için tıkla ...
Korhan Bey'in uyardığı hata. On Error Resume Next satırını kaldırınca ActiveSheet.ShowAllData satırında patladı.

Kodu şu şekilde deneyin.

C++: 
Private Sub TextBox1_Change()
    'On Error Resume Next
    Application.ScreenUpdating = False
    '--------------------------------
    If ActiveSheet.FilterMode Then
        ActiveSheet.ShowAllData
    End If
     '--------------------------------
    Son = Cells(Rows.Count, 2).End(3).Row
    Say = 1
    Liste = Range("B4:B" & Son).Value
    ReDim Kriter(1 To 1)
    Kriter(Say) = ""
    For X = 1 To UBound(Liste)
        If UCase(Replace(Replace(Liste(X, 1), "ı", "I"), "i", "İ")) Like "*" & _
        UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*" Then
            Say = Say + 1
            ReDim Preserve Kriter(1 To Say)
            Kriter(Say) = CStr(Liste(X, 1))
        End If
    Next
    Range("B2:G" & Son).AutoFilter Field:=1, Criteria1:=Kriter, Operator:=xlFilterValues
    If TextBox1 = Empty Then
        Range("B2:G" & Son).AutoFilter Field:=1
    End If
    Set bul = Nothing
    Application.ScreenUpdating = True
End Sub
 
Hiç bir değişiklik olmadı hemen çalışmayı durduruyor.
 
Son olarak şunu denermisiniz.
C++: 
Private Sub TextBox1_Change()
    'On Error Resume Next
    Application.ScreenUpdating = False
        ActiveSheet.AutoFilterMode = False
    Son = Cells(Rows.Count, 2).End(3).Row
    Say = 1
    Liste = Range("B4:B" & Son).Value
    ReDim Kriter(1 To 1)
    Kriter(Say) = ""
    For X = 1 To UBound(Liste)
        If UCase(Replace(Replace(Liste(X, 1), "ı", "I"), "i", "İ")) Like "*" & _
        UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*" Then
            Say = Say + 1
            ReDim Preserve Kriter(1 To Say)
            Kriter(Say) = CStr(Liste(X, 1))
        End If
    Next
    Range("B2:G" & Son).AutoFilter Field:=1, Criteria1:=Kriter, Operator:=xlFilterValues
    If TextBox1 = Empty Then
        Range("B2:G" & Son).AutoFilter Field:=1
    End If
    Set bul = Nothing
    Application.ScreenUpdating = True
End Sub
 
On error resume next kaldırınca dediğim satırda hata veriyordu.
Verdiğim 2 kod ile hatası çalıştı.
Şu an aklıma gelen başka bir çözüm yok.
 
Erkan Akayay' Alıntı:
On error resume next kaldırınca dediğim satırda hata veriyordu.
Verdiğim 2 kod ile hatası çalıştı.
Şu an aklıma gelen başka bir çözüm yok.
Genişletmek için tıkla ...
Siz hangi excelde çalıştırdınız 2007 de mi yoksa başka versiyonda mı ?
 
m.gur' Alıntı:
Siz hangi excelde çalıştırdınız 2007 de mi yoksa başka versiyonda mı ?
Genişletmek için tıkla ...
Merhaba,
Bende 2007 de problemsiz çalıştı. Siz kendi kodunuzu tamamen silin bu yapıştırdığımı kullanın. Yine olmazsa verilerinizi yeni bir kitaba kopyalayın. Makro olarak yine bu yapıştırdığımı kullanın.

Kod: 
Private Sub TextBox1_Change()
    On Error Resume Next
    Application.ScreenUpdating = False
    ActiveSheet.ShowAllData
    Son = Cells(Rows.Count, 2).End(3).Row
    Say = 1
    Liste = Range("B4:B" & Son).Value
    ReDim Kriter(1 To 1)
    Kriter(Say) = ""
    For X = 1 To UBound(Liste)
        If UCase(Replace(Replace(Liste(X, 1), "ı", "I"), "i", "İ")) Like "*" & _
        UCase(Replace(Replace(TextBox1, "ı", "I"), "i", "İ")) & "*" Then
            Say = Say + 1
            ReDim Preserve Kriter(1 To Say)
            Kriter(Say) = CStr(Liste(X, 1))
        End If
    Next
    Range("B2:G" & Son).AutoFilter Field:=1, Criteria1:=Kriter, Operator:=xlFilterValues
    If TextBox1 = Empty Then
        Range("B2:G" & Son).AutoFilter Field:=1
    End If
    Set bul = Nothing
    Application.ScreenUpdating = True
End Sub
 
@necati bey, sizin verdiğiniz kodlar @m.gur beyin hata verdiği dediği orjinal kodlar.
Kodlarda bir hata olmasın?
@m.gur Office 365 kullanıyorum. 2007'de deneme şansım yok. Sadece On error resume next satırını kaldırıp kodda hata veren yerin tespitini yapabildim.
 
Erkan Akayay' Alıntı:
@necati bey, sizin verdiğiniz kodlar @m.gur beyin hata verdiği dediği orjinal kodlar.
Kodlarda bir hata olmasın?
@m.gur Office 365 kullanıyorum. 2007'de deneme şansım yok. Sadece On error resume next satırını kaldırıp kodda hata veren yerin tespitini yapabildim.
Genişletmek için tıkla ...
Evet aynı kodlar. Sadece eski bir tecrübemden dolayı bunu tavsiye ediyorum. Yeni versiyonlarda oluyor mu bilmiyorum ama eski versiyonlarda sebepsiz yere takılmalar olurdu. Ben de bu şekilde hallettiğim tecrübemi sundum.
 
Yeni bir çalışma sayfası açıp verilerimi oraya kopyaladım en son yazdığınız kodları yapıştırdım. Sonuç hiç değişmedi. Sanırım anlayamadığımız başka bir problem var. Son çare 2007 yi kaldırıp üst versiyonlarda devam edeceğim benim için zor olacak ama başka çözüm yok gibi. Emeği geçen herkese teşekkür ederim. Sizleri yordum hakkınızı helal edin. İyi akşamlar.
 
Ne yazık ki olmadı yine. Dediğim gibi anlayamadığımız başka bir sorun var.
 
Bende ofis 365 sürümü var. Bu sürümde dosyanız bende hata vermedi.

Ben size alternatif bir kod sunuyorum. Bu da çalışmazsa bence 2007 sürümü terk etmeyi düşünmenizi tavsiye ederim.

C++: 
Private Sub TextBox1_Change()
    Dim Son As Long
    Application.ScreenUpdating = False
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
    Son = Cells(Rows.Count, 2).End(3).Row
    ActiveSheet.Range("B2:G" & Son).AutoFilter Field:=1, Criteria1:="=*" & TextBox1 & "*"
    If TextBox1 = Empty Then Range("B2:G" & Son).AutoFilter Field:=1
    Application.ScreenUpdating = True
End Sub
 
Merhaba
Dosyanızda başka kodlar var mı eğer varsa bunlar çalışıyor mu?
referanslarda bir sıkıntı olabilir.(Missingle) başlayan refaranslar varmı
 
halit3' Alıntı:
Merhaba
Dosyanızda başka kodlar var mı eğer varsa bunlar çalışıyor mu?
referanslarda bir sıkıntı olabilir.(Missingle) başlayan refaranslar varmı
Genişletmek için tıkla ...
Evet başka kodlar da var fakat onlar çalışıyor.
 
Bugün akşama kadar 3 Pc ile uğraştım. Öncelikle 5 yıldır kullanmadığım masaüstü bilgisayara Ofis 2007 kurdum hiç bir hata sorun yaşamadan dosya orada gayet güzel çalıştı. Daha sonra başka bir Laptop ta Ofis 2019 kurulu ve 2007 yi kurdum orada da sorunsuz çalıştı. Hem 2007 de hem 2019 da hatasız. Daha sonra sürekli kullandığım Laptop da gereksiz gördüğüm tüm programları sildim. yüklü ofis 2007 ve 2019 dahil. Yeniden başlatıp Ofis 2007 yi kurdum. Dosyayı açtım büyük umutla textbox a girip tek bir harf yazdım excel hemen çalışmayı durdurdu. Yani ne yaptımsa olmadı. Sonunda bilgisayarda bir sorun var dedim ama hiçbir sorun yok virüs programım var lisanslı. defalarca tarattım herhangi bir olumsuz yok. Şu an ne yapacağımı şaşırdım ya bilgisayarı değiştireceğim 2019 un rahat çalışabilmesi için yada o dosyayı textbox değil de başka bir şekilde yapmaya çalışacağım. Önerilerinizi bekliyorum. Saygılar..
 
m.gur' Alıntı:
Bugün akşama kadar 3 Pc ile uğraştım. Öncelikle 5 yıldır kullanmadığım masaüstü bilgisayara Ofis 2007 kurdum hiç bir hata sorun yaşamadan dosya orada gayet güzel çalıştı. Daha sonra başka bir Laptop ta Ofis 2019 kurulu ve 2007 yi kurdum orada da sorunsuz çalıştı. Hem 2007 de hem 2019 da hatasız. Daha sonra sürekli kullandığım Laptop da gereksiz gördüğüm tüm programları sildim. yüklü ofis 2007 ve 2019 dahil. Yeniden başlatıp Ofis 2007 yi kurdum. Dosyayı açtım büyük umutla textbox a girip tek bir harf yazdım excel hemen çalışmayı durdurdu. Yani ne yaptımsa olmadı. Sonunda bilgisayarda bir sorun var dedim ama hiçbir sorun yok virüs programım var lisanslı. defalarca tarattım herhangi bir olumsuz yok. Şu an ne yapacağımı şaşırdım ya bilgisayarı değiştireceğim 2019 un rahat çalışabilmesi için yada o dosyayı textbox değil de başka bir şekilde yapmaya çalışacağım. Önerilerinizi bekliyorum. Saygılar..
Genişletmek için tıkla ...

yeni bir excel çalışma kitabı açıp dosya-aç-gözat-sorunlu kitabınızı seçin-menüdeki aç ve onar'a tıklayın. Böyle denediniz mi hiç ? Kodunuz sorunsuz çalıştıktan sonra hiç yeni kod eklediniz mi ? Özellikle textbox'ın tetiklediği yada textbox'ın faydalandığı bir kod, eğer varsa son eklediğiniz kodu silerek bir deneyin. Birde bilgisayarınızın olay görüntüleyicisinden hata hakkında bilgi alabilirsiniz, ben buna benzer bir sorunla karşılaştığım da dll7 gibi bir hata veriyordu.
 
Hiç bir şey değişmedi yine çalışmayı durduruyor.. Dosyaya herhangi bir kod eklemesi yapılmadı.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst