Formüldeki işlevi vba veya makro ile yapma (sıralı dolu hücre içeriği gelmesin)

[angloth]

Merhaba

Ekte gönderdiğim Örnek tabloya göre Sayfa1 de bulunan bilgilerde AD sütununda tarih olup olmadığını kontrol ederek, boş olması durumunda S sütunundaki makbuz numaralarını sırası ile Sayfa2 B sütununa getirmesini istiyorum. AD sütunu günlük olarak tarih girişi yapıldığından her tarih girişinde işlemi yapmasını istiyorum.

=EĞERHATA(İNDİS(Sayfa1!$S$3:$S$10000;KÜÇÜK(EĞER(Sayfa1!$S$3:$S$10000<>"";EĞER(Sayfa1!$AD$3:$AD$10000="";SATIR(Sayfa1!$AD$3:$AD$10000)-2));SATIR($A1));1);"")

bu formül ile yapmak istediğim işlemi yapabilmekteyim fakat bunu bir hücreye tarih girilerek değişiklik olduğu takdirde 1dk gibi bekleme yapıyor bu formülü makro veya vba kodu ile yaptırma imkanımız var mı acaba ? Şuan 1200 satırlık veriyi kontrol ediyor, verilerin tamamını eklediğimde 50.000 satırın üstüne çıktığında bekleme süresi de artacak diye düşünüyorum.

https://dosya.co/pntnbnq4km95/örnek.xls.html]örnek.xls - 3.4 MB[/URL]

 

[angloth]

Yardımcı olabilecek yok mu bu konuda ?

 

[angloth]

Koray hocamın formül ile yardımcı olduğu işlem hakkında vba kod ile yapabilmemi sağlamama yardımcı olurmusunuz ?
şimdiden teşekkür ederim.

 

[Korhan Ayhan]

Dosya linki sıkıntılı sanırım. Tekrar paylaşınız.

 

[pazzini]

Özür dilerim, kendi konum ile ilgili cevabı bu entry altında vermişim, silmeyi de bulamadım.

 

[angloth]

Dosya linki sıkıntılı sanırım. Tekrar paylaşınız.

http://dosya.co/pntnbnq4km95

Ben denedim hocam dosya linki çalışıyor fakat siteye ben yapıştırırken yanlış yaptım sanırım.

 

[Korhan Ayhan]

Deneyiniz.

Aşağıdaki kodu boş bir modüle uygulayınız.

Option Explicit

Sub Aktar()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = 0
    Application.Calculation = -4105
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")

    Sheets("Sayfa2").Range("B5:B" & Rows.Count).ClearContents

    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select F2 From [Sayfa1$R3:AD] Where Not Isnull(F2) And Isnull(F13)"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    If Kayit_Seti.RecordCount > 0 Then
        Sheets("Sayfa2").Range("B5").CopyFromRecordset Kayit_Seti
        Application.Calculation = -4135
        Application.ScreenUpdating = 1
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
    Else
        Application.Calculation = -4135
        Application.ScreenUpdating = 1
        MsgBox "Uygun veri bulunamadı!", vbInformation
    End If
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
End Sub

Aşağıdaki kodu ise Sayfa2'nin kod bölümüne uygulayınız. Sayfa2'yi tıkladığınızda kod otomatik olarak çalışacaktır.

Option Explicit

Private Sub Worksheet_Activate()
    Call Module1.Aktar
End Sub

 

[angloth]

Koray hocam denedim ama AD sütununa tarih girilenleri de getiriyor.

 

[Orion1]

Veri tabanı olarak (Access) kullanmanızı tavsiye ederim.Onda tarih sütununa string giremezsiniz.

 

[Korhan Ayhan]

Paylaştığınız dosyada şimdi tekrar denedim. Bende sorun olmuyor. Tarih girilenler listelenmiyor.

 

[angloth]

Paylaştığınız dosyada şimdi tekrar denedim. Bende sorun olmuyor. Tarih girilenler listelenmiyor.

Özür dilerim hocam hata benden kaynaklanmış AD den önce sütun eklediğim için AE olmuş verdiğiniz kodda AD ve F13 kısmını değiştirince oldu. çok teşekkür ederim verdiğiniz kod istediğim gibi çalışıyor elinize sağlık.

son birşey daha sorayım hocam size ben bu sayfa2 yi şifreli olarak kullanıyorum. o zaman kod çalışmıyor debug hatası veriyor, bunun için birşey yapabilir miyim ? sadece B sütunun hücre kilidini açsam yeterli olur mu ?

 

[Korhan Ayhan]

Deneyin bakalım olacak mı..