- Katılım
- 15 Mart 2005
- Mesajlar
- 43,785
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Gmail adresime gönderir misiniz?
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Gmail adresime gönderir misiniz?
Profilimdeki adresi güncelledim. Tekrar deneyiniz.
ayhan.korhan@gmail.com adresine gönderebilirsiniz.
Sub TEKRAR_ETMEYEN_KAYITLARI_LİSTELE()
Dim SD As Object, Veri(), Dizi()
Dim X As Long, Son As Long, Say As Long, Zaman As Double
Zaman = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set SD = CreateObject("Scripting.Dictionary")
Son = Cells(Rows.Count, "A").End(3).Row
Veri = Range("A1:B" & Son).Value
For X = 1 To UBound(Veri, 1)
SD.Item(Veri(X, 1)) = SD.Item(Veri(X, 1)) + 1
Next
ReDim Dizi(1 To Son, 1 To 2)
For X = 1 To UBound(Veri, 1)
If SD.Item(Veri(X, 1)) = 1 Then
Say = Say + 1
ReDim Preserve Dizi(1 To Son, 1 To 2)
Dizi(Say, 1) = "'" & Veri(X, 1)
Dizi(Say, 2) = "'" & Veri(X, 2)
End If
Next
Range("D1").Resize(Say, 2) = Dizi
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Merhaba,
Gönderdiğiniz dosyayı inceledim.
505623. satırdaki veriniz 255 karakter uzunluğunda bu sebeple dizi hata veriyor. Ayrıca verilerinizde "=" işareti ile başlayan satırlar var. Bunlarda hata veriyor.
Aşağıdaki kod verileri diziye alırken başına tek tırnak (') işareti ekliyor. Bu sorun olmaz derseniz verilerinizi yedekleyip kodu deneyebilirsiniz.
Dosyanızda kodu denediğimde bende 15 saniyede sonuç veriyor.
Kod:Sub TEKRAR_ETMEYEN_KAYITLARI_LİSTELE() Dim SD As Object, Veri(), Dizi() Dim X As Long, Son As Long, Say As Long, Zaman As Double Zaman = Timer Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Set SD = CreateObject("Scripting.Dictionary") Son = Cells(Rows.Count, "A").End(3).Row Veri = Range("A1:B" & Son).Value For X = 1 To UBound(Veri, 1) SD.Item(Veri(X, 1)) = SD.Item(Veri(X, 1)) + 1 Next ReDim Dizi(1 To Son, 1 To 2) For X = 1 To UBound(Veri, 1) If SD.Item(Veri(X, 1)) = 1 Then Say = Say + 1 ReDim Preserve Dizi(1 To Son, 1 To 2) Dizi(Say, 1) = "'" & Veri(X, 1) Dizi(Say, 2) = "'" & Veri(X, 2) End If Next Range("D1").Resize(Say, 2) = Dizi Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation End Sub
Sn.Korhan hocam örnek dosyayı yükleyebilir misiniz, kodların ne yaptığını çözemedim