Çözüldü Alt alta olan satırları tek hücrede birleştirme.

[Bluekaya]

Merhabalar bir sorum olacaktı şimdi elimde bir mail listesi var ama bunlar alt alta satırdalar ben bunları tek bir hücre içinde aralarında virgül ile toplamak istiyorum.

Örnek elimdeki liste.
Ahmet@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.
Mehmet@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.
Zeynep@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.
hasret@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.

İSTEDİĞİM

Ahmet@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.,mehmet@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.,zeynep@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.,hasret@Link ve Reklam İçerikli Paylaşımlar Engellenme Sebebidir.,

hangi formül ile yapabilirim alt alta olan hücreleri tek hücrede birleştirmeyi ?

 

[azraep]

=BİRLEŞTİR(A1;",";A2;",";A3)

şeklinde yapabilirsiniz.

 

[Bluekaya]

=BİRLEŞTİR(A1;",";A2;",";A3)
şeklinde yapabilirsiniz.

10.000 satır var ama öyle tek tek çok zor 10.000 adet birleştirmek

 

[azraep]

aşağıdaki kodu örneğiniz göre uyarlarsanız işinize yarar umarım

Dim ss, x As Integer
Dim Tek As String

Sub TekHucre()
    Cells(2, 2) = Empty
    ss = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To ss
        Tek = Cells(x, 1)
        Cells(2, 2) = Trim(Cells(2, 2) & Tek & ",")
    Next x
End Sub

 

[Mahir64]

Merhaba,
Kullanıcı Tanımlı Fonksiyon (KTF)
Boş bir modüle ekleyin.

Public Function BIRLESTIRA(ALAN As Range, Optional sALAN As String = " ") As String
Dim sonuc As String, c As Range
On Error GoTo Hata
For Each c In ALAN
    If c <> Empty Then sonuc = sonuc & c.Value & sALAN
Next c
sonuc = Left(sonuc, Len(sonuc) - Len(sALAN))
BIRLESTIRA = sonuc
On Error GoTo 0
   Exit Function
Hata:
    BIRLESTIRA = "#Error#"
End Function

birleştirme için formülü yazın.

=BIRLESTIRA(A1:A10000;",")

 

[Bluekaya]

aşağıdaki kodu örneğiniz göre uyarlarsanız işinize yarar umarım

Dim ss, x As Integer
Dim Tek As String

Sub TekHucre()
    Cells(2, 2) = Empty
    ss = Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To ss
        Tek = Cells(x, 1)
        Cells(2, 2) = Trim(Cells(2, 2) & Tek & ",")
    Next x
End Sub

bunu macro düğmesi ile mi aktifleştireyim ?

 

[Bluekaya]

Merhaba,
Kullanıcı Tanımlı Fonksiyon (KTF)
Boş bir modüle ekleyin.

Public Function BIRLESTIRA(ALAN As Range, Optional sALAN As String = " ") As String
Dim sonuc As String, c As Range
On Error GoTo Hata
For Each c In ALAN
    If c <> Empty Then sonuc = sonuc & c.Value & sALAN
Next c
sonuc = Left(sonuc, Len(sonuc) - Len(sALAN))
BIRLESTIRA = sonuc
On Error GoTo 0
   Exit Function
Hata:
    BIRLESTIRA = "#Error#"
End Function

birleştirme için formülü yazın.

=BIRLESTIRA(A1:A10000;",")

usta bunu nereye yapacağım acemiyiz biraz

 

[Mahir64]

ALT+ F11 tuşlarına basın kodu göreceksiniz.

 

[azraep]

bunu macro düğmesi ile mi aktifleştireyim ?

evet düğme eklemesi gerekir. yada direk makrolardan istediğiniz zaman çalıştırabilirsiniz

 

[Bluekaya]

ALT+ F11 tuşlarına basın kodu göreceksiniz.

başkan bende #AD? hatası veriyor yani nasıl çalıştıracağız bunu

 

[Mahir64]

Öncelikle KTF ve makro konusunda biraz araştırma yapın. Şu an başka birşey öneremeyeceğim.

 

[Bluekaya]

evet düğme eklemesi gerekir. yada direk makrolardan istediğiniz zaman çalıştırabilirsiniz

örnek dosya yollasam uyarlayabilirmisiniz J sütunundakileri birleştirmeye çalışıyorum bilginize.

 

[azraep]

Dener misiniz?

 

[Bluekaya]

Dener misiniz?

teşekkür ederim oldu