kodların Private Sub Worksheet_SelectionChange kısmına uğruyor olma sorunu

[euphrates55]

module1

Option Explicit
Public BUL As Range

Sub ARA()
    Dim S1 As Worksheet
    
    Set S1 = Sheets("GT")
    
    If Not BUL Is Nothing Then
        Set BUL = S1.Range("G2:H" & S1.Rows.Count).FindNext(BUL)
    Else
        Set BUL = S1.Range("G2:H" & S1.Rows.Count).Find(S1.Range("F1").Value, , , , , xlNext)
    End If
    If Not BUL Is Nothing Then
        S1.Cells(BUL.Row, "DZ").End(1).Offset(0, 1).Select
    Else
        MsgBox "Aranan kayıt bulunamadı !" & Chr(10) & Chr(10) & S1.Range("F1").Value, vbCritical
    End If
End Sub

sayfa 1

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Intersect(Target, Range("F1")) Is Nothing Then Exit Sub
    Set BUL = Nothing
End Sub

dosyamda kullandığım bul makrosu var ve module1 de yazılı. sayfa1 e ise Private Sub Worksheet_SelectionChange komutu ile yazılan bir kod olduğundan dolayı bazı yerlerde kullandığım makroları adımlarken hep Private Sub Worksheet_SelectionChange kısmına geçiyor ve sanırım bu da zaman kaybı yaratarak işlem süresini arttırıyor.
Private Sub Worksheet_SelectionChange kısmını sildiğimde kod doğru çalışmıyor. bunu nasıl aşabilirim.

 

[Muzaffer Ali]

Merhaba.

Application.enableevents=false
satırını çalıştırdığınızda "SelectionChang" gibi otomatik çalışan kodlar tetiklenmez.
Application.enableevents=true satırını çalıştırdıktan sonra normale döner.

Örnek

Sub ARA()
   
    Dim S1 As Worksheet
   
    Set S1 = Sheets("GT")
   
    If Not BUL Is Nothing Then
        Set BUL = S1.Range("G2:H" & S1.Rows.Count).FindNext(BUL)
    Else
        Set BUL = S1.Range("G2:H" & S1.Rows.Count).Find(S1.Range("F1").Value, , , , , xlNext)
    End If
    If Not BUL Is Nothing Then
        Application.enableevents=false 'SelectionChange gibi otomatik çalışan kodlar bu satırdan sonra çalışmasın
        S1.Cells(BUL.Row, "DZ").End(1).Offset(0, 1).Select 'Burada hücre seçme kodu olduğundan "SelectionChange" kodları çalışıyor.
       Application.enableevents=true 'otomatik çalışan kodlar bu satırdan sonra çalışsın
    Else
        MsgBox "Aranan kayıt bulunamadı !" & Chr(10) & Chr(10) & S1.Range("F1").Value, vbCritical
    End If
End Sub

 

[euphrates55]

Teşekkürler. ama ya ben anlayamadım ya da bir şey fark etmedi.

 

[Muzaffer Ali]

Bir şey fark etmediyse dosyanızda bulunan başka yerlerde sorun var demektir. Eğer mümkünse dosyanızı ekleyin üzerinde bakalım.

 

[euphrates55]

dediğinizi yaptım ama mesela kullandığım bir kod var bir hücreyi kopyalayıp aşağıya doğru 6 satır atlayarak yapıştırıyor. bunu yaparken yukarıdaki kodda Private Sub Worksheet_Change(ByVal Target As Range) komutu olduğundan her yapıştırma adımında bu koda da uğruyor. ve tabi muhtemelen kullandığım tüm kodlarda her hücre değiştiğinde bu kod tetikleniyor. sizin verdiğiniz kodları da koymama rağmen değişen bir şey olmadı. yani bu durumda sanırım ilk kodda değil de ikinci kodda bir şey yapmamız gerekiyor.

 

[euphrates55]

hiç bir şey olmadı ben size örnek dosya göndereyim. yeni bir kod yazma şansınız olursa diye yapmak istediğimi de açıkça dosya içine yazdım. belki böyle daha kolay olur.

 

[YUSUF44]

Paylaştığınız dosyada bahsettiğinz kodlar olduğuna emin misiniz?

 

[euphrates55]

Paylaştığınız dosyada bahsettiğinz kodlar olduğuna emin misiniz?

kod yok. eminim belki yeni kod yazılır diye boş gönderdim. ama kod istenirse zaten ilk yorumda var. bazen sorun aramaktansa baştan yapmak daha iyi olur demiştim...

 

[YUSUF44]

Bulmaca çözüyoruz bir nevi yani

Yukarda kodunuzla 6 satır atlayıp yapıştırdığınızı belirtmiştiniz, örnek dosyanızda ise F1'e yazdığınız değerin bulunduğu hücrenin seçilmesinden bahsediyorsunuz. Hangisi için kod yazılacak?

Takdir edersiniz ki mevcut kodların değiştirilmesi farklı, baştan kod yazılması ayrı işlemlerdir ve her ikisi için de tam olarak ne istendiği açıkça bilinmelidir.

 

[euphrates55]

şöyle yapsak olacak muhtemelen #6. mesajdaki örnekte olmasını istediğim olayı dosya içerisinde anlattım. bunu yapabilirsek benim işim hallolur. teşekkürler.

 

[YUSUF44]

Anadığım kadarıyla aşağıdaki kkodları sayfanın kod bölümüne yapıştırıp deneyin. F1 hücresini değiştirdiğinizde istediğiniz işlemi yapar. Yalnız H sütununa girdiğiniz veriler metin biçimliyken, F1 hücresi sayı biçimli. Bu nedenle F1'e sayısal veri girdiğinizde H sütununda bulamayacaktır:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F1]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
If Selection.Count > 1 Then Exit Sub
son = Cells(Rows.Count, "H").End(3).Row
If WorksheetFunction.CountIf(Range("H3:H" & son), Target) = 0 Then
    MsgBox Target & " verisi H sütununda bulunmamaktadır!", vbInformation
Else
    sat = WorksheetFunction.Match(Target, [H:H], 0)
    sut = WorksheetFunction.Max(105, Cells(sat, Columns.Count).End(xlToLeft).Column + 1)
    Cells(sat, sut).Select
End If
End Sub

Ayrıca anladığım kadarıyla arama işleminin "içerir" şeklinde yapılmasını ve sırayla tüm bulunanların dikkate alınmasını istiyorsunuz ama maalesef bu nasıl yapılır bilemedim.