• DİKKAT

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

Excel önemli destek

Katılım
21 Mayıs 2018
Mesajlar
1
Excel Vers. ve Dili
excel 2016
türkçe
merhaba;

A SÜTÜNÜ B SÜTÜNÜ C SÜTÜNÜ

256.0001 - 123 - 8965
256.0001 - 8965 -
200.4000 - 654789 -
200.5000 - 65412 - 65987;69857;96322
200.5000 - 65987 -
200.5000 - 69857 -
200.5000 - 96322 -

arkadaşlar A sütünü stokkodu, B sütünü barkodu, C sütünü ilave barkod alanıdır. Yapmak istediğim eğer a sütünündaki kodlarda birbirine eşit olan varsa karşılarındaki barkodları ; ile c sütünunda toplamak istiyorum. yukarıda örnek var ilk barkod kalacak diğerleri yan sütüna ; ile ayrılmış halde geçeçek.

acil yardımcı olabilir misiniz?
 
Son düzenleme:
Merhaba,

Bu kodları kullanabilirsiniz..

Kod:
[SIZE="2"]Sub Emre()
    Dim sd As Object, i&
    Set sd = CreateObject("Scripting.Dictionary")
    For i = 1 To Range("A65536").End(3).Row
        If Not sd.exists(Cells(i, 1).Value) Then
            sd.Add Cells(i, 1).Value, Cells(i, 2).Value
                Else
            sd.Item(Cells(i, 1).Value) = sd.Item(Cells(i, 1).Value) & ";" & Cells(i, 2).Value
        End If
    Next i
    Range("C:D").ClearContents
    Range("C1").Resize(sd.Count, 1) = Application.Transpose(sd.keys)
    Range("D1").Resize(sd.Count, 1) = Application.Transpose(sd.Items)
    Set sd = Nothing: i = Empty
End Sub[/SIZE]
 
Alternatif olsun, İlk satırda başlıklar olduğunu var saydım.
Kod:
Sub a()
On Error Resume Next
For i = Cells(Cells.Rows.Count, 1).End(3).Row To 1 Step -1
If Cells(i, 1) = Cells(i - 1, 1) Then
yaz = Cells(i, 2) & " " & yaz
Else
Cells(i, 3).Value = Replace(Trim(Cells(i, 2) & " " & yaz), " ", ", ")
yaz = ""
End If
Next
End Sub
 
Geri
Üst