Birleştirilmiş verilerde mükerrer olanlar

[mbattal]

Arkadaşlar Merhaba,
EK'teki dosyama bakarak yardım edebilirseniz sevinirim
Teşekkürler

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdaki kodu standart br modül sayfasına kopyalayıp, çalıştırınız.

Sub Mukerrer_Olmayanlar()
Dim arrVeri()
Dim y%, x%, i%, j%
Dim sh1 As Worksheet, sh2 As Worksheet
Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")
y = 1
ReDim Preserve arrVeri(1 To y)
arrVeri(y) = sh1.Cells(6, 3)
For i = 6 To sh1.Cells(65536, 3).End(xlUp).Row
    For j = 1 To UBound(arrVeri)
        If sh1.Cells(i, 3) = arrVeri(j) Then: x = x + 1
    Next j
    If x = 0 Then
       y = y + 1
       ReDim Preserve arrVeri(1 To y)
       arrVeri(y) = sh1.Cells(i, 3)
    End If
    x = 0
Next i
sh2.Range("D6:D" & sh2.Cells(65536, "D").End(xlUp).Row).ClearContents
For i = 1 To UBound(arrVeri)
    sh2.Cells(i + 5, "D") = arrVeri(i)
Next i
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

 

[ceyrek]

Dosyanızı düzenledim ama eğer farklı çözümler isterseniz mükerrer kayitlarla ilgili bir bölüm var, oraya da göz atabilirsiniz.
İyi çalışmalar...


Not: ben dosyayla uğraşırken sayın fpc cevap yazmış ama uğraşım boşa gitmesin, dosyayı ekliyorum.