• DİKKAT

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

Excel Farklı Sütunlardaki Verileri Ara ve Birleştir

Katılım
7 Mayıs 2013
Mesajlar
3
Excel Vers. ve Dili
2007
Merhaba,
Excelde çözmem gereken bir konu var yardımcı olabilirseniz sevinirim.

Olayı özetlemek gerekirse;
Elimde 4 sütunlu bir tablo var. Ben bu 4 sütundan sadece 2 tanesindeki veriyi kullanıyorum B ve D.
Bu sütunlardaki verileri bir şekilde toplu halde eşleştirmem ve veritabanına aktarmam gerekli.

Sütun Anlamları:
B sütunu: Ürün Kategori Kodu
D sütunu: Ürün Kodu

Şu anda elimdeki veriler şu şekilde sıralanıyor:
B-----------------------------------D
33----------------------------------45
34----------------------------------45
35----------------------------------45

Bu da şu anlama geliyor. 45 kodlu ürün hem 33 hem 34 hem de 35 kodlu kategorilerde listelenmekte. Ancak bunu içeri alabilmem için tüm kategori kodlarının tek satırda ve virgülle ayrılmış olması gerekli. Düzen çok önemli değil. Kopyala yapıştır yapabilirim.

Elimdeki veri şu şekilde olsun yeter:
B-----------------------------------D
33,34,35---------------------------45

Yardımcı olabilir misiniz?
 
Sn. Adem Altan, -
Birleştirme olduktan sonra diğer satırlar ne olacak?
-A ve C Sütununda ne gibi verilerin var?
-Bu birleştirme bir kereye mahsus mu olacak?
örnek dosya hazırlayıp, sonucun nasıl olacağını gösterirseniz, mutlaka bir çözüm bulunur, bu şekilde bir sürü soruyu da beraberinde getirir.
aşağıdaki kodu birleştirmek için kullanabilirsin
Kod:
Sub IDNOLAR()
Dim i As Long, k As Range, sat As Long
Sheets("Sheet1").Select
Application.ScreenUpdating = False
Range("G1:H65536").ClearContents
For i = 1 To Cells(65536, "B").End(xlUp).Row
    Set k = Range("G1:G65536").Find(Cells(i, "D").Value)
    If k Is Nothing Then
        sat = sat + 1
        Cells(sat, "G").Value = Cells(i, "D").Value
        Cells(sat, "H").Value = Cells(i, "B").Value
        Else
        k.Offset(0, 1).Value = k.Offset(0, 1).Value & "," & " " & Cells(i, "B").Value
    End If
Next i
Set k = Nothing
Application.ScreenUpdating = True
MsgBox "İşlem Tamam"
End Sub
[/CODE]
 
Son düzenleme:
Geri
Üst