Belli bir sütundaki(alandaki) verileri tek hücreye virgülle yazdır(otomatik-butonsuz)

[gurayavci]

Merhaba,

Ekteki excel dosyasındada açıklamasını yaptığım şekilde belli bir sütundaki veriyi 1 hücreye araya virgül yada tire ile yazdırmak istiyorum.

Bu dosya ile sevkiyat öncesi Paletlerin üzerine içerik ve adres bilgisi yazdırıyorum

Verilerin alınacağı sütunda palet içindeki ürünlerin hangi siparişlere ait olduğu yazıyor.

Amacım palet içerisinde hangi sipariş numaraları var sorusuna cevaben bir hücreye birleştirilmiş veri aktarmak.


içerik listesinde A123 numaralı ürün ve b123 numaralı ürün FT555 numaralı siparişin içinde olduğu için ürün içerik listesinde iki satırdada FT555 yazar. ben bir hücreye sadece 1 adet FT555 ve varsa başka sipariş numarası 1 adet diğer sipariş numarasından yazdırmak istiyorum.

sipariş no--------ürün no
FT555 A123
FT555 b123

 

[AdemCan]

Merhaba, E14 hücresini Metin olarak biçimlendirip, 1 numaralı sekmenin kod sayfasına ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
    If Target.Row > 41 And Target.Column < 53 And Target.Column = 3 Then
        no = WorksheetFunction.CountIf(Range("C42:C52"), Target.Value)
            If no = 1 Then
                If Range("E14").Value = "" Then
                    Range("E14").Value = Target.Value
                Else
                    Range("E14").Value = Range("E14").Value & "." & Target.Value
                End If
            End If
    End If
End Sub

 

[gurayavci]

Adem bey teşekkür ediyorum

Sadece Makro olarak eklediğimde çalıştıramadım, örnek yüklediğim dosyada çalıştırıp gönderme şansınız var mı, yada düğmeye atamasını mı yapmam gerekiyor bu kodun onu çözemedim

 

[gurayavci]

Merhaba, E14 hücresini Metin olarak biçimlendirip, 1 numaralı sekmenin kod sayfasına ekleyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Selection.Count > 1 Then Exit Sub
    If Target.Row > 41 And Target.Column < 53 And Target.Column = 3 Then
        no = WorksheetFunction.CountIf(Range("C42:C52"), Target.Value)
            If no = 1 Then
                If Range("E14").Value = "" Then
                    Range("E14").Value = Target.Value
                Else
                    Range("E14").Value = Range("E14").Value & "." & Target.Value
                End If
            End If
    End If
End Sub

Belirttiğiniz gibi E14 ü metin yapıp Sayfanın kod satırına ekledim fakat gözüme çarpan birşey var,

Sayfa adı Kod ekranında farklı görünüyor

 

[AdemCan]

Kodları ekledikten sonra C42 - C52 hücreleri arasına giriş yaptığınız zaman E14 hücresine birleştirme işlemi olur.

Spoyler: Çalışma Görüntüsü

 

[gurayavci]

Kodları ekledikten sonra C42 - C52 hücreleri arasına giriş yaptığınız zaman E14 hücresine birleştirme işlemi olur.

Spoyler: Çalışma Görüntüsü

Ekli dosyayı görüntüle 239880

Evet Adem bey gösterdiğiniz gibi yazıldığında veriyi alıyor, sanırım benim eksik verdiğim bi bilgi sebebiyle takıldım şu an


Firma Order No Sütununda Formülüm var
Hemen solunda başka bir sütuna yazılan veri üzerine Firma Order No sütununa Düşeyara ile başka bir excel dosyasından veri çekiyor.

Elle yazdığımı belirttiğiniz gibi ekliyor
Birde elle yazılan veriyi değiştirdiğimde E14'e yeni veri olarak virgül sonrasına ekliyor fakat aynı hücrede önceden yazan rakamı E14'ten silmiyor
Formülün çektiği veriyi eklemiyor, bunun için nasıl bir yol izleyebiliriz

 

[Korhan Ayhan]

Eğer Ofis 365 kullansaydınız yeni gelen fonksiyonlarla işiniz kolaylaşacaktı. Ama siz eski bir sürüm kullanıyorsunuz. Bunun için size KTF önerebilirim.

Aşağıdaki fonksiyonu boş bir modüle uygulayınız.

Hücrede kullanım şekli;

=K_BİRLEŞTİR(C42:C52;",")

Option Explicit

Function K_BİRLEŞTİR(Alan As Range, Optional Ayıraç As String = "-")
    Dim Dizi As Object, Veri As Range, Say As Long
  
    Application.Volatile True
  
    Set Dizi = VBA.CreateObject("Scripting.Dictionary")
  
    For Each Veri In Alan
        If Veri.Value <> "" And Veri.RowHeight <> 0 Then
            If Not Dizi.Exists(Veri.Value) Then
                Say = Say + 1
                Dizi.Add Veri.Value, Say
            End If
        End If
    Next
  
    K_BİRLEŞTİR = Join(Dizi.Keys, Ayıraç)

    Set Dizi = Nothing
End Function

 

[gurayavci]

Eğer Ofis 365 kullansaydınız yeni gelen fonksiyonlarla işiniz kolaylaşacaktı. Ama siz eski bir sürüm kullanıyorsunuz. Bunun için size KTF önerebilirim.

Aşağıdaki fonksiyonu boş bir modüle uygulayınız.

Hücrede kullanım şekli;

=K_BİRLEŞTİR(C42:C52;",")

Option Explicit

Function K_BİRLEŞTİR(Alan As Range, Optional Ayıraç As String = "-")
    Dim Dizi As Object, Veri As Range, Say As Long
 
    Application.Volatile True
 
    Set Dizi = VBA.CreateObject("Scripting.Dictionary")
 
    For Each Veri In Alan
        If Veri.Value <> "" And Veri.RowHeight <> 0 Then
            If Not Dizi.Exists(Veri.Value) Then
                Say = Say + 1
                Dizi.Add Veri.Value, Say
            End If
        End If
    Next
 
    K_BİRLEŞTİR = Join(Dizi.Keys, Ayıraç)

    Set Dizi = Nothing
End Function

Korhan bey teşekkür ederim fakat office 2016 kullanıyorum ,k_birleştir işe yaramıyor

 

[Korhan Ayhan]

Merhaba,

Dosyanızı açınız.
ALT+F11 ile kod editörüne ulaşınız.
INSERT-MODULE seçeneği ile boş bir modül ekleyiniz.
Paylaştığım makro kodunu bu modüle yapıştırınız.

Sonra dosyanızı "Makro İçerebilen Excel Çalışma Kitabı" biçiminde kayıt ediniz.

Son olarak önerdiğim şekilde hücreye yazdığınızda kullanabilirsiniz.

 

[gurayavci]

Merhaba,

Dosyanızı açınız.
ALT+F11 ile kod editörüne ulaşınız.
INSERT-MODULE seçeneği ile boş bir modül ekleyiniz.
Paylaştığım makro kodunu bu modüle yapıştırınız.

Sonra dosyanızı "Makro İçerebilen Excel Çalışma Kitabı" biçiminde kayıt ediniz.

Son olarak önerdiğim şekilde hücreye yazdığınızda kullanabilirsiniz.

Korhan bey çok teşekkür ediyorum, çalıştı

Adem bey çok teşekkür ediyorum