• DİKKAT

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

Eğersay'dan daha hızlı çalışacak yöntem var mı

Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Merhaba Arkadaşlar,

B sütununda 5.000 hücrelik verilerim var. E sütununda da 60.000 hücrelik arşiv verilerim var. 5.000 hücrelik verilerden hangilerinin 60.000 lik datada olduğunu bulmaya çalışıyorum. Doğal olarak bunu EĞERSAY ile yapıyorum. Ama 5.000 hücre için 10 dakikaya kadar uzayabiliyor.

Bu tespit işlemini daha hızlı yapmanın EĞERSAY'dan başka bir yolu, yöntemi var mıdır acaba !
 
Merhaba.

EĞERSAY işlevini KOŞULLU BİÇİMLENDİRME içerisinde kullanmayı denediniz mi acaba?
.
 
Ömer Baran üstadım çok teşekkür ediyorum. Çok iyi fikir, sağolunuz. ilk fırsatta deneyip sonucunu burada paylaşacağım. Sağlıcakla kalın.
 
Ömer Baran üstadım fikir için teşekkür ediyorum. Evet Koşullu Biçimlendirme bir miktar daha hızlı çalışıyor. Ama bu sefer de renge göre Filtreleme açısından 10.000 Adetlik filtreleme sınırına takılıyor :(
 
Sayın SERDAR'ın önerisini göz önünde bulundarmanızda yarar var.

Tabi örnek belge olmadığından söylenebilecek çok fazla şey de yok.
Ayrıca adetlerin bulunmasındaki amaç da bilinmiyor.
B sütunundaki veri E sütununda varsa ne yapacaksınız, yoksa ne yapacaksınız,
veri türü (sayı/metin/tarih vs) nedir vs. hiçbir şey belli değil.

Belki de makro kullanılarak bir şeyler yapılabilir ama gerçek belgeyle aynı yapıda ve
gerçek belgedeki verileri temsil edebilecek nitelikte veriler içeren bir örnek belge yüklenip,
yapılması istenilen işlem tam olarak açıklanmalıdır.
.
 
Merhaba.

İşlem yine EĞERSAY işlevi üzerinden gerçekleştiriliyor.

-- Belge açıkken ALT+F11 tuşlarına basıp VBA ekranını görüntüleyin.
-- VBA üst menüsündan INSERT->MODÜLE'yi seçin,
-- Sol taraftan MODULE1'in adına fareyle çift tıklayın ve sağdaki boş alana aşağıdaki kod'u yapıştırın.
-- Fareyi kullanarak, imlecin kod'un ilk satırına gelmesini sağlayın,
-- F5 tuşuna basarak kod'u çalıştırın.

(Benim bilgisayarımda işlem 45-50 saniye kadar sürdü)
.
Kod:
Sub FORMULLE_AYIKLA()
Set m = Sheets("MARMARA"): Set e = Sheets("EGE")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
zaman = Timer
son = m.Cells(Rows.Count, 2).End(3).Row
With m.Range("C2:C" & son)
    .Formula = "=COUNTIF(EGE!$B$2:$B$60001,B2)": .Value = .Value
End With
m.Range("B1:C" & son).AutoFilter Field:=2, Criteria1:="1"
m.Range("B2:B" & son).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
m.Range("B1:C" & son).AutoFilter Field:=2
m.Range("C2:C" & son).ClearContents
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı. Süre: " & Format(Timer - zaman, "0.00") & " saniye", vbInformation
End Sub
 
Sayın Ömer BARAN üstadım müthişsiniz. Gerçekten çok hızlı. Eskiye nazaran uçuyor resmen :)
sonuç : 77 saniye. harika. sağlıcakla kalın.
 
Merhaba,

Ömer Bey sorunuza çözüm sunmuş. Alternatif olarak bu şekilde de kullanabilrisiniz.

Kod:
Sub Olanları_Sil()
Dim d As Object, alan As Range
Dim s1 As Worksheet, z As Double, i As Long
z = TimeValue(Now)
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Set s1 = Sheets("MARMARA")
Set d = CreateObject("Scripting.Dictionary")
    For Each alan In Sheets("EGE").[B2:B6001]
        d(alan.Text) = ""
    Next alan
    i = 2
    Do While s1.Cells(i, 2) <> ""
        If d.Exists(Trim(s1.Cells(i, 2))) Then
            s1.Rows(i).Delete
        Else
            i = i + 1
        End If
    Loop
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
MsgBox CDate(TimeValue(Now) - z), vbInformation
End Sub
 
.

Benden de bir alternatif.

Kod:
Sub BenzerleriSil()

Z = TimeValue(Now)

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

    j = 2
    For i = Worksheets("EGE").Cells(Rows.Count, j).End(xlUp).Row To 2 Step -1
        If Worksheets("EGE").Cells(i, j).Value = Worksheets("MARMARA").Cells(i, j).Value Then
            Worksheets("MARMARA").Rows(i).Delete
        End If
    Next i

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

MsgBox CDate(TimeValue(Now) - Z), vbInformation

End Sub

Bende 21 - 25 saniye sürdü.


.
 
Ziynettin üstadım ilginize çok teşekkür ediyorum. çok kısa sürede işlem tamam. Çok iyi bir alternatif daha oldu. Sağlıcakla kalın.
 
Son düzenleme:
İdris Serdar üstadım ilginize çok teşekkür ediyorum. çok kısa sürede işlem tamam. Çok iyi bir alternatif daha oldu. Sağlıcakla kalın.
 
Geri
Üst