Tekrar eden bilgileri toplayıp farklı olanlarını tek hücrede birleştirme

S

syrsln

Katılım
4 Şubat 2021
Mesajlar
12
Excel Vers. ve Dili
Excel 2007 - Türkçe
Merhabalar,

Elimde yaklaşık 7.000 satırdan oluşan bir liste var (oem parça listesi), bu listede en sol sütundaki orjinal oem kodlarının karşısında yer alan yerli parça üretici oem numaraları mevcut.

Yapmak istediğim ise bu tekrar eden oem kodlarına karşılık gelen yerli üretici oem numaralarını bir satırda (baştaki sütunda orjinal kod, yanındakinde marka ve onun yanındakinde yerel üretici kodları virgül ile ayrılmış biçimde aynı satırda olacak şekilde) birleştirmek.

Bununla ilgili nasıl bir formül uygulamam gerekiyor?


Örnek resim burada
https://www.hizliresim.com/lbdqrtm
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,245
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Merhaba,

Görsel yerine örnek dosya paylaşırsanız daha faydalı olacaktır. Dosyanızı paylaşım sitelerine yükleyip link verebilirsiniz.

Örnek dosyanızda görmek istediğiniz sonucuda ekleyiniz.
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,372
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
Bugün pazar, herkesin işi var gücü var dinlenmesi var, soruyu sordum hemen yanıt verilsin olmaz.

Aynı stok kodu ile farklı üretici firmalar var, bu konuda bir açıklamanız var mı?
Sorunuzu gören kişi büyük olasılıkla bunu hissedip belki bakmak bile istemiyor olabilir.

Soru net olmalı, yanıt tek, yoksa yazışmalar uzar gider.
Bilmem anlatabildim mi? :)
 
S

syrsln

Katılım
4 Şubat 2021
Mesajlar
12
Excel Vers. ve Dili
Excel 2007 - Türkçe
sevgili moderatör arkadaş Necdet bey,

Öncelikle ilk cümlenize cevap vereyim : "soruyu sordum hemen yanıt verilsin olmaz" demişsiniz; sanırım bunu tarihlere bakmadan söylediniz zira bir önceki cevabımı 23 mayıs'ta vermişim (geçen pazar hariç 10 gün geçmiş) yeterli bir süre diye düşünüyorum!?

ikincisi : 23 mayıs'ta bir dosya paylaşmışım "Aynı stok kodu ile farklı üretici firmaları" açıklayan, gösteren ve nasıl bir çıktı istediğimiz açıkça belirten!

üçüncüsü : burası kullandığım ilk forum değil, neyin nasıl işlediğini az - çok biliyorum (bir dönem forum yöneticiliği de yapmış biri olarak)

sonuç olarak böyle artistçe bir mesaj yazamadan önce biraz daha düşünmenizi, ve incelemenizi tavsiye ederim ki forumunuzu kullanan insanlar burada bulunmaktan, sorunlarına çözüm bulmaktan zevk alsınlar; irrite olmasınlar...
 
T

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @syrsln
aşağıdaki kodu deneyiniz.
Kod: 
Sub oem_birlestir()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn,  SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Set BUL = s2.Columns(1).Find(s1.Cells(i, "A"))
    If BUL Is Nothing Then
        sn = sn + 1
        s2.Cells(sn, "A") = s1.Cells(i, "A")
        s2.Cells(sn, "B") = s1.Cells(i, "B")
        s2.Cells(sn, "C") = s1.Cells(i, "C")
    Else
        s2.Cells(BUL.Row, "B") = s2.Cells(BUL.Row, "B") & " , " & s1.Cells(i, "B")
        s2.Cells(BUL.Row, "C") = s2.Cells(BUL.Row, "C") & " , " & s1.Cells(i, "C")
    End If
Next i
MsgBox "Birleştirme işlemi tamamlandı"
Application.ScreenUpdating = True
End Sub
Üretici Marka (b sutununu) birleştirmek istemiyorsanız
s2.Cells(BUL.Row, "B") = s2.Cells(BUL.Row, "B") & " , " & s1.Cells(i, "B")
satırını etkisiz yaparsınız.
 
S

syrsln

Katılım
4 Şubat 2021
Mesajlar
12
Excel Vers. ve Dili
Excel 2007 - Türkçe
tahsinanarat' Alıntı:
Sn. @syrsln
aşağıdaki kodu deneyiniz.
Kod: 
Sub oem_birlestir()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s2.Range("A3:C65536").ClearContents
Dim i, sn,  SonSat As Integer
sn = 2
SonSat = s1.[A65536].End(3).Row
For i = 3 To SonSat
    Set BUL = s2.Columns(1).Find(s1.Cells(i, "A"))
    If BUL Is Nothing Then
        sn = sn + 1
        s2.Cells(sn, "A") = s1.Cells(i, "A")
        s2.Cells(sn, "B") = s1.Cells(i, "B")
        s2.Cells(sn, "C") = s1.Cells(i, "C")
    Else
        s2.Cells(BUL.Row, "B") = s2.Cells(BUL.Row, "B") & " , " & s1.Cells(i, "B")
        s2.Cells(BUL.Row, "C") = s2.Cells(BUL.Row, "C") & " , " & s1.Cells(i, "C")
    End If
Next i
MsgBox "Birleştirme işlemi tamamlandı"
Application.ScreenUpdating = True
End Sub
Üretici Marka (b sutununu) birleştirmek istemiyorsanız
s2.Cells(BUL.Row, "B") = s2.Cells(BUL.Row, "B") & " , " & s1.Cells(i, "B")
satırını etkisiz yaparsınız.
Genişletmek için tıkla ...
Çok teşekkür ederim @tahsinarat
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,372
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
Alternatif olsun, dizilerle yapılmış bir çözüm.
Sonuç E1 sütunundan itibaren yazdırılır, siz isterseniz başka bir sayfaya da yazdırabilirsiniz.

Not : Biraz fazla eleştirmişim, dikkat etmemişim mesaj tarihlerine, yaşlılığa verin gaari , özür:)

Kod: 
Public Sub Grupla()

'VBA Ekranı->   Tools
'               References
'               Microsoft Sicriptin Runtime
'               SEÇİLİ OLMALI

Dim i   As Long, _
    j   As Long, _
    k   As Long, _
    dic As New Dictionary, _
    arr As Variant, _
    deg As Variant

arr = Sayfa1.Range("A1").CurrentRegion.Value

j = 1

For i = 2 To UBound(arr, 1)
    deg = arr(i, 1) & arr(i, 2)
    If Not dic.Exists(deg) Then
        j = j + 1
        dic.Add deg, j
        arr(j, 1) = arr(i, 1)
        arr(j, 2) = arr(i, 2)
        arr(j, 3) = arr(i, 3)
    Else
        k = dic.Item(deg)
        arr(k, 3) = arr(k, 3) & ", " & arr(i, 3)
    End If
Next i

Sayfa1.Range("E1").Resize(j, 3) = arr

End Sub
 
S

syrsln

Katılım
4 Şubat 2021
Mesajlar
12
Excel Vers. ve Dili
Excel 2007 - Türkçe
Necdet' Alıntı:
Merhaba,
Alternatif olsun, dizilerle yapılmış bir çözüm.
Sonuç E1 sütunundan itibaren yazdırılır, siz isterseniz başka bir sayfaya da yazdırabilirsiniz.

Not : Biraz fazla eleştirmişim, dikkat etmemişim mesaj tarihlerine, yaşlılığa verin gaari , özür:)

Kod: 
Public Sub Grupla()

'VBA Ekranı->   Tools
'               References
'               Microsoft Sicriptin Runtime
'               SEÇİLİ OLMALI

Dim i   As Long, _
    j   As Long, _
    k   As Long, _
    dic As New Dictionary, _
    arr As Variant, _
    deg As Variant

arr = Sayfa1.Range("A1").CurrentRegion.Value

j = 1

For i = 2 To UBound(arr, 1)
    deg = arr(i, 1) & arr(i, 2)
    If Not dic.Exists(deg) Then
        j = j + 1
        dic.Add deg, j
        arr(j, 1) = arr(i, 1)
        arr(j, 2) = arr(i, 2)
        arr(j, 3) = arr(i, 3)
    Else
        k = dic.Item(deg)
        arr(k, 3) = arr(k, 3) & ", " & arr(i, 3)
    End If
Next i

Sayfa1.Range("E1").Resize(j, 3) = arr

End Sub
Genişletmek için tıkla ...
Teşekkür ederim emekleriniz için, elinize sağlık...
 
S

serdarfb

Katılım
6 Mayıs 2011
Mesajlar
10
Excel Vers. ve Dili
excel 2013-türkçe
Merhaba benzer bir sorunum var biraz farklı olarak

Benim istediğim örnek olsun diye kalın olarak yazdığım 89554569 sayısını hücreye yazdığımda 89554569 sayısının olduğu kodları sayfa2 de bir hücrede toplaması

yardımcı olabilirseniz memnun olurum
 
N

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,372
Excel Vers. ve Dili
Ofis 365 Türkçe
serdarfb' Alıntı:
Merhaba benzer bir sorunum var biraz farklı olarak

Benim istediğim örnek olsun diye kalın olarak yazdığım 89554569 sayısını hücreye yazdığımda 89554569 sayısının olduğu kodları sayfa2 de bir hücrede toplaması

yardımcı olabilirseniz memnun olurum
Genişletmek için tıkla ...
Merhaba,
Soru benzer olabilir ama yeni konu açınız ve paylaşım sitelerinden birine örnek dosyanızı ve olması gereken durumu belirtirseniz çözüme ulaşmanız daha hızlı olacaktır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst