• DİKKAT

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

Veri karşılaştırma

Katılım
1 Ağustos 2019
Mesajlar
839
Excel Vers. ve Dili
Türkçe excel 2016
İngilizce excel 2016
Sayfa1 in B ve C sütunlarında 15.10.2020 formatında 7000 satırlık tarih verisi var. Ben B ve C sutunlarindaki tarihleri karşılaştırıp D sütununa aynı olanlara bir şey yazmasın farklı olanlara ise karşılıklarını FARKLİ yazsın istiyorum. Bunu makro ile nasıl yapabilirim. Saygılar
 
Bu kodları dener misiniz?
Kod:
Sub karsilastir()
Application.ScreenUpdating = False
Range("d2:d" & Range("d" & Rows.Count).End(3).Row).ClearContents

For i = 2 To Range("b" & Rows.Count).End(3).Row
If Cells(i, 2) <> Cells(i, 3) Then Cells(i, 4) = "FARKLI"
Next i

Application.ScreenUpdating = True
End Sub
 
Makroyu hızlandırmak mümkün mü acaba
 
Bu kodları dener misiniz?
İki kodu da 8000 satırda denedim hızlı çalışıyor.
Kod:
Sub dizi_ile_karsilastir()

Dim ilk_dizi() As Long, ikinci_dizi() As Long

Range("d2:d" & Range("d" & Rows.Count).End(3).Row).ClearContents

b = Range("b2:b" & Range("b" & Rows.Count).End(3).Row).Value
c = Range("c2:c" & Range("c" & Rows.Count).End(3).Row).Value

ReDim ilk_dizi(1 To UBound(b, 1))
ReDim ikinci_dizi(1 To UBound(c, 1))

For i = 2 To Range("b" & Rows.Count).End(3).Row

    ilk_dizi(i - 1) = Cells(i, 2)
    ikinci_dizi(i - 1) = Cells(i, 3)

Next i

For y = 2 To UBound(b, 1)

    If ilk_dizi(y-1) <> ikinci_dizi(y-1) Then Cells(y, 4) = "FARKLI"
    
Next y

End Sub
 
Bu kodları dener misiniz?
İki kodu da 8000 satırda denedim hızlı çalışıyor.
Kod:
Sub dizi_ile_karsilastir()

Dim ilk_dizi() As Long, ikinci_dizi() As Long

Range("d2:d" & Range("d" & Rows.Count).End(3).Row).ClearContents

b = Range("b2:b" & Range("b" & Rows.Count).End(3).Row).Value
c = Range("c2:c" & Range("c" & Rows.Count).End(3).Row).Value

ReDim ilk_dizi(1 To UBound(b, 1))
ReDim ikinci_dizi(1 To UBound(c, 1))

For i = 2 To Range("b" & Rows.Count).End(3).Row

    ilk_dizi(i - 1) = Cells(i, 2)
    ikinci_dizi(i - 1) = Cells(i, 3)

Next i

For y = 2 To UBound(b, 1)

    If ilk_dizi(y-1) <> ikinci_dizi(y-1) Then Cells(y, 4) = "FARKLI"
   
Next y

End Sub
Sayın Faye deneyip size dönüş yapacağım
 
Alternatif;

Hız olarak avantaj sağlayabilir.

C++:
Option Explicit

Sub Verileri_Karsilastir()
    Dim Veri As Variant, Son As Long, X As Long, Zaman As Double
    
    Zaman = Timer
    
    Son = Cells(Rows.Count, 2).End(3).Row
    Veri = Range("B1:D" & Son).Value
    Range("D:D").ClearContents
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> Veri(X, 2) Then
            Veri(X, 3) = "FARKLI"
        End If
    Next
    
    Range("B1").Resize(Son, 3) = Veri
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
End Sub
 
Geri
Üst