Düşeyara bir sonrakini bul

[Korhan Ayhan]

Diğer kodla sonuç neydi?

 

[nadirornek]

Bir daha sayfa2 B sütununa değiştirdim 2438 satırı 137,42 sn buldu
Excel hücre ekranı kapanıp sonra açıldı.Uzun zaman değilmi.

 

[nadirornek]

Diğer kodta 5-6 dakika

 

[Korhan Ayhan]

Aşağıdaki kodu deneyiniz. Sanırım daha hızlı sonuç verecektir.

İ5 işlemcide aşağıdaki sonuçları elde ettim.

Her iki sayfada 5.000 satır veride denedim. İşlem 5,30 saniye sürdü.
Her iki sayfada 25.000 satır veride denedim. İşlem 127,52 saniye sürdü.

Option Explicit

Sub HIZLI_ARAMA()
    Dim Zaman As Double, Dizi As Variant, Veri As Variant
    Dim X As Long, WF As WorksheetFunction
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Zaman = Timer
    
    Set WF = WorksheetFunction
    
    Set S2 = Sheets("Sayfa2")
    S2.Range("A:A").Insert xlRight
    Son = S2.Cells(Rows.Count, 2).End(3).Row
    Dizi = S2.Range("B2:B" & Son).Value
    
    ReDim Veri(Son)
    
    For X = 1 To UBound(Dizi, 1)
        Veri(X) = Trim(Dizi(X, 1)) & "#" & WF.CountIf(S2.Range("B$2:B" & X + 1), Dizi(X, 1))
    Next
    
    S2.Range("A1").Resize(Son) = Application.Transpose(Veri)
    
    
    Set S1 = Sheets("Sayfa1")
    S1.Range("A:A").Insert xlRight
    Son = S1.Cells(Rows.Count, 2).End(3).Row
    Dizi = S1.Range("B2:B" & Son).Value
    
    ReDim Veri(1 To Son - 1, 1 To 3)
    
    For X = 1 To UBound(Dizi, 1)
        Veri(X, 1) = Trim(Dizi(X, 1)) & "#" & WF.CountIf(S1.Range("B$2:B" & X + 1), Dizi(X, 1))
        Veri(X, 2) = Dizi(X, 1)
        Veri(X, 3) = Evaluate("=IFERROR(VLOOKUP(""" & Veri(X, 1) & """," & S2.Name & "!A:C,3,0),"""")")
    Next
    
    S1.Range("A2").Resize(Son - 1, 3) = Veri
    
    S1.Range("A:A").Delete
    S2.Range("A:A").Delete
    
    Set WF = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format((Timer - Zaman), "0.00")
End Sub

 

[nadirornek]

Korhan Bey,Şimdi verilerimi 60 sn altında buluyor.
Emeğiniz için çok teşekkür ederim.

 

[endexci]

Aşağıdaki kodu deneyiniz.

10.000 satırlık veride 30 saniyede işlemi tamamladı. (İ7 işlemci)

Veri sayısı artarsa yavaşlama yaşayabilirsiniz.

Private Sub CommandButton1_Click()
    Dim S1 As Worksheet, S2 As Worksheet, Veri As Variant, Son As Long, Zaman As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
   
    S1.Range("A:A").Insert Shift:=xlToRight
    Son = S1.Cells(Rows.Count, 2).End(3).Row
   
    With S1.Range("A2:A" & Son)
        .Formula = "=TRIM(B2)&COUNTIF(B$1:B2,B2)"
        .Value = .Value
    End With
   
   
    S2.Range("A:A").Insert Shift:=xlToRight
    Son = S2.Cells(Rows.Count, 2).End(3).Row
   
    With S2.Range("A2:A" & Son)
        .Formula = "=TRIM(B2)&COUNTIF(B$1:B2,B2)"
        .Value = .Value
    End With
   
    On Error Resume Next
   
    With S1.Range("C2:C" & Son)
        .Formula = "=IFERROR(VLOOKUP(A2," & S2.Name & "!A:C,3,0),"""")"
        .Value = .Value
    End With
   
    S1.Range("A:A").Delete
    S2.Range("A:A").Delete
   
    Set S1 = Nothing
    Set S2 = Nothing
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Merhabalar,

Çok faydalı bir çalışma olmuş emeği geçenin ellerine sağlık, çalışma ile ilgili 2 sorum olacak Sayfa1 sayfasında butona tıkladığımız zaman Sayfa2 sayfasında kaç tane satır var ise o kadarına işlem yapıyor bu durum düzeltilebilir mi ? Örn: Sayfa1 de 28000 satır veri var Sayfa2 de 24000 veri var Sayfa1 de 24000 adet veriye sonuç çıkarttı. diğer sorum formül ile yapacak olursak hangi formülü kullanmamız gerekir konu ile ilgili yardımlarınız için şimdiden teşekkür ederim.