• DİKKAT

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

Verileri birleştirme yada öyle birşey

Katılım
3 Haziran 2013
Mesajlar
23
Excel Vers. ve Dili
2016 türkçe
Merhaba arkadaşlar.Ben yapamadım belki çok kolay bir şey ama yardımcı olursanız sevinirim.
A B C sütünlarında müşteri kodları var .Ben bunları tek sütun da toplamak istiyorum hiçbiri eksilmeden.Yani A da 2768 tane sayı var, B de 2774 , C de 2768.
Ama Bunların bazıları farklı hiçbiri kaybolmadan toplamam lazım bunları alt alta.

Teşekkürler şimdiden.
 

Ekli dosyalar

Şu kodları kullanabilirsiniz;

Kod:
Function Aralık(Rky As Range) As Range
   Set Aralık = Application.Intersect(Rky, Rky.Parent.UsedRange)
End Function

Function Evn(Rky As Range) As Object
   Dim hücre As Range
   Set Evn = CreateObject("Scripting.Dictionary")
   For Each hücre In Rky
      If Not Evn.Exists(hücre.Value) Then
        If hücre.Value <> "" Then
            Evn.Add hücre.Value, 1
        End If
      End If
   Next
End Function

Sub Sütun_Karşılaştır(Ilk As Range, Ikinci As Range, Ucüncü As Range, Sonuc As Range)
   Dim b1 As Object, b2 As Object, b3 As Object, hücre As Range, key As Variant
   Set b1 = Evn(Aralık(Ilk))
   Set b2 = Evn(Aralık(Ikinci))
   Set b3 = Evn(Aralık(Ucüncü))
   Set hücre = Sonuc.Cells(1, 3)
   For Each key In b1
      If Not b2.Exists(key) Then
         hücre.Value = key
         Set hücre = hücre.Offset(1, 0)
      End If
   Next
   For Each key In b2
      If Not b1.Exists(key) Then
         hücre.Value = key
         Set hücre = hücre.Offset(1, 0)
      End If
   Next
    For Each key In b3
      If Not b1.Exists(key) Then
         hücre.Value = key
         Set hücre = hücre.Offset(1, 0)
      End If
   Next
End Sub

Sub Karşılaştır()
   Sütun_Karşılaştır Columns(1), Columns(2), Columns(3), Columns(2).Offset(0, 1)
End Sub
Örnek dosyayı da ekliyorum.
 

Ekli dosyalar

Geri
Üst