Küçük ve Büyük Tarihi Bulma,

[MrExcelMr]

Merhaba;

min ve mak formülleri ile değerleri buluyoruz. Sayfadaki satır sayısı 5.000 üzeri olduğundan dolayı kullanmakta olduğumuz formül dizi olması nedeniyle excel donuyor. Bunun önüne geçilmesi için makro konusunda destek olabilir misiniz.

 

[Orion1]

H ile I sütunları boş.Orayada örnek olması için veri girermisiniz.

 

[MrExcelMr]

H ile I sütunları boş.Orayada örnek olması için veri girermisiniz.

 

[Orion1]

Küçük bir örnek dosya yollayabilirmisiniz?

 

[Korhan Ayhan]

Deneyiniz.

DİZİ formüldür.

H2;

=MIN(IF(A$2:A$100=G2;B$2:B$100))

I2;

=MAX(IF(A$2:A$100=G2;B$2:B$100))

 

[MrExcelMr]

Deneyiniz.

DİZİ formüldür.

H2;

=MIN(IF(A$2:A$100=G2;B$2:B$100))

I2;

=MAX(IF(A$2:A$100=G2;B$2:B$100))

Korhan Bey Merhaba,

Şu anda sizin paylaşmış olduğunuz formül ile işlemlerimizi yapıyoruz. Makro ile yapmak istiyoruz. G sütunundaki aşı kodu eklenmektedir.

 

[Korhan Ayhan]

Çok pardon. Ben makro olayına dikkat etmemişim.

Ama aslında 5000 satır üzeri veri çok kasma yapmaması gerekir.

Eğer verileriniz tarih sıralı ise arama fonksiyonları ile sonuç alınabilir.

 

[MrExcelMr]

Çok pardon. Ben makro olayına dikkat etmemişim.

Ama aslında 5000 satır üzeri veri çok kasma yapmaması gerekir.

Eğer verileriniz tarih sıralı ise arama fonksiyonları ile sonuç alınabilir.

A sütunu ile XX sütunu arasında başlıklar ve satırlar dolu durumda. Bu yüzden kasılıyor olabilir. Belkide PC özelliklerinden olabilir. Makro konusunda destek olabilrseniz çok seviniriz. .

 

[Korhan Ayhan]

Tarihleriniz küçükten büyüğe sıralı mı?

 

[MrExcelMr]

Tarihleriniz küçükten büyüğe sıralı mı?

yok hocam değil

 

[GursoyC]

Pivot tablo özelliğini kullanmayı deneyebilirsiniz. Formül olmayacağı için kasılmayabilir. Sadece yenile yapmanız yeterli olacaktır.

 

[Korhan Ayhan]

Bu işlemin G sütununa veri girdikçe veri girişi anında mı olmasını istiyorsunuz? Yoksa G sütununda hazır veriler bunlara toplu olarak ilgili değerlerin mi gelmesini istiyorsunuz?

 

[MrExcelMr]

Bu işlemin G sütununa veri girdikçe veri girişi anında mı olmasını istiyorsunuz? Yoksa G sütununda hazır veriler bunlara toplu olarak ilgili değerlerin mi gelmesini istiyorsunuz?

G sütununda hazır veriler bunlara toplu olarak ilgili değerlerin gelmesini istiyorum.

 

[MrExcelMr]

Destek olabilir misiniz.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Min_Max_Tarihleri_Aktar()
    Dim Zaman As Double, Baglanti As Object, Kayit_Seti As Object
    Dim S1 As Worksheet, Dizi_Min As Object, Dizi_Max As Object, Veri As Variant
    Dim Minimum_Tarih_Listesi As Variant, Maksimum_Tarih_Listesi As Variant
    Dim Son As Long, X As Long, Say As Long
    
    Zaman = Timer
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Dizi_Min = CreateObject("Scripting.Dictionary")
    Set Dizi_Max = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("Sayfa1")
    
    S1.Range("H2:I" & S1.Rows.Count).ClearContents
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    Son = S1.Cells(S1.Rows.Count, "G").End(3).Row
    If Son < 3 Then Son = 3
    
    Veri = S1.Range("G2:G" & Son).Value2
    
    ReDim Gecici_Liste(1 To S1.Cells(S1.Rows.Count, 1).End(3).Row, 1 To 2)
    
    
    Set Kayit_Seti = Baglanti.Execute("Select * From [" & S1.Name & "$A:B] Order By [Aşı Kodu] Asc, [Gönderim Tarihi] Asc")
    
    Minimum_Tarih_Listesi = Application.Transpose(Kayit_Seti.GetRows)
    
    Set Kayit_Seti = Baglanti.Execute("Select * From [" & S1.Name & "$A:B] Order By [Aşı Kodu] Asc, [Gönderim Tarihi] Desc")
    
    Maksimum_Tarih_Listesi = Application.Transpose(Kayit_Seti.GetRows)
    
    
    For X = LBound(Minimum_Tarih_Listesi, 1) To UBound(Minimum_Tarih_Listesi, 1)
        Say = Say + 1
        
        If Not Dizi_Min.Exists(Minimum_Tarih_Listesi(X, 1)) Then
            Dizi_Min.Add Minimum_Tarih_Listesi(X, 1), Say
            Gecici_Liste(Say, 1) = Minimum_Tarih_Listesi(X, 2)
        End If
        
        If Not Dizi_Max.Exists(Minimum_Tarih_Listesi(X, 1)) Then
            Dizi_Max.Add Maksimum_Tarih_Listesi(X, 1), Say
            Gecici_Liste(Say, 2) = Maksimum_Tarih_Listesi(X, 2)
        End If
    Next

    
    ReDim Liste(1 To S1.Cells(S1.Rows.Count, 1).End(3).Row, 1 To 2)
    
    Say = 0
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Say = Say + 1
        If Dizi_Min.Exists(Veri(X, 1)) Then
            Liste(Say, 1) = Gecici_Liste(Dizi_Min.Item(Veri(X, 1)), 1)
            Liste(Say, 2) = Gecici_Liste(Dizi_Max.Item(Veri(X, 1)), 2)
        End If
    Next
    
    If Say > 0 Then
        S1.Range("H2").Resize(Say, 2) = Liste
    End If
    
    If Baglanti.State <> 0 Then Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    Set Dizi_Min = Nothing
    Set Dizi_Max = Nothing
    Set S1 = Nothing

    MsgBox "Veri aktarımı tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub

 

[MrExcelMr]

Korhan Bey teşekkür ederiz. İlginiz için.

 

[Korhan Ayhan]

Hız olarak asıl dosyanızda ne kadar sürede işlem tamamlandı.

 

[1mak1mak]

Ben Dolar kuru için kullanıyorum Tarih içinde uygulanabilir sanırım Fikir vermesi açısından görüntü paylaştım.

 

[MrExcelMr]

Hız olarak asıl dosyanızda ne kadar sürede işlem tamamlandı.

12.000 satırda 7,14 sn