İsimleri tek hücrede birleştirme

izcik · 27 Mayıs 2020

Merhaba iki adet örnek dosyada, A sütunundaki isimler makro ile B sütununda birleştirilmesi gerekmektedir.

İki dosya arasındaki fark, birisi iki kelimelik isimler, diğeri üç kelimelik isimler

Alternatif makrolar da olursa sevinirim. incelerim. Tek çözümü varsa da hiç sorun yok. İşimi görür.

Teşekkürler

ornek1.xls dosyasını indir - download

ornek1.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

ornek2.xls dosyasını indir - download

ornek2.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

...

Korhan Ayhan · 27 Mayıs 2020

B sütunu birleştirilmiş hücre şeklinde mi olacak?

izcik · 27 Mayıs 2020

Korhan Ayhan' Alıntı:
B sütunu birleştirilmiş hücre şeklinde mi olacak?

Uzmanım mümkünse birleştirilmiş, (kolayca göreyim diye birleştirilmiş yapmıştım.

Ama eğer uğraştırırsa birleştirilmeden de olur.
Örnek ismin en üstteki ilk satırı olan B2 hücresine aktarılabilir.

Hepsi olur.

Saygılar

Korhan Ayhan · 27 Mayıs 2020

Deneyiniz.

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_2()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
  
    ReDim Liste(1 To Rows.Count, 1 To 1)
  
    For X = LBound(Veri) To UBound(Veri) Step 2
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1)
    Next

    If Say > 0 Then Range("B2").Resize(Say, 1) = Liste

    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_3()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri) Step 3
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1) & " " & Veri(X + 2, 1)
        Say = Say + 1
        Liste(Say, 1) = Empty
        Say = Say + 1
        Liste(Say, 1) = Empty
    Next

    If Say > 0 Then Range("B2").Resize(Say, 1) = Liste

    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

mustafa1205 · 27 Mayıs 2020

Korhan Hocamın müsaadesiyle;

ilk çalışma için =A2&" "&A3

İkinci çalışma için =A2&" "&A3&" "&A4

olarak uygulayarak aşağı doğru çekiniz.

Korhan Ayhan · 27 Mayıs 2020

Elbette işlemler bahsettiğiniz şekilde birleştirilmiş hücreler şeklinde de yapılabilir. Fakat excel hücrelerinde yapılan bu fiziksel işlemler size zaman kaybettirecektir.

izcik · 27 Mayıs 2020

Korhan Ayhan' Alıntı:
Elbette işlemler bahsettiğiniz şekilde birleştirilmiş hücreler şeklinde de yapılabilir. Fakat excel hücrelerinde yapılan bu fiziksel işlemler size zaman kaybettirecektir.

Sayın uzmanım hepsini deneyeceğim. Eğer sizi uğraştırmaz ise birleştirilmiş makroları da denemek istiyorum. Zaman kaybetmeye razıyım

Teşekkürler

izcik · 27 Mayıs 2020

Bir de uzmanım yukarda verdiğiniz ilk kodun üç isimliler için olanını da oluşturursanız sevinirim.

Birleştirilmiş hücre makrolarını da merakla bekleyeceğim.

Korhan Ayhan · 27 Mayıs 2020

#4 nolu mesajımı revize ettim. İki dosya için kodlama ekledim. Birisi 2 hücreden oluşan isimler için, diğeri 3 hücreden oluşan isimler içindir.

Aşağıdaki kodlar ise birleştirilmiş hücrelere göre listeleme yapmaktadır.

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_2()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri) Step 2
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1)
        Say = Say + 1
        Liste(Say, 1) = Empty
    Next

    If Say > 0 Then
        Range("B2").Resize(Say, 1) = Liste
        For X = 2 To Son - 1 Step 2
            With Range("B" & X & ":B" & X + 1)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        Next
    End If
   
    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_3()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri) Step 3
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1) & " " & Veri(X + 2, 1)
        Say = Say + 1
        Liste(Say, 1) = Empty
        Say = Say + 1
        Liste(Say, 1) = Empty
    Next

    If Say > 0 Then
        Range("B2").Resize(Say, 1) = Liste
        For X = 2 To Son - 1 Step 3
            With Range("B" & X & ":B" & X + 2)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        Next
    End If
       
    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

izcik · 27 Mayıs 2020

Korhan Ayhan' Alıntı:

#4 nolu mesajımı revize ettim. İki dosya için kodlama ekledim. Birisi 2 hücreden oluşan isimler için, diğeri 3 hücreden oluşan isimler içindir.

Aşağıdaki kodlar ise birleştirilmiş hücrelere göre listeleme yapmaktadır.

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_2()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri) Step 2
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1)
        Say = Say + 1
        Liste(Say, 1) = Empty
    Next

    If Say > 0 Then
        Range("B2").Resize(Say, 1) = Liste
        For X = 2 To Son - 1 Step 2
            With Range("B" & X & ":B" & X + 1)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        Next
    End If
   
    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_3()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri) Step 3
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1)
        Say = Say + 1
        Liste(Say, 1) = Empty
        Say = Say + 1
        Liste(Say, 1) = Empty
    Next

    If Say > 0 Then
        Range("B2").Resize(Say, 1) = Liste
        For X = 2 To Son - 1 Step 3
            With Range("B" & X & ":B" & X + 2)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
        Next
    End If
       
    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

Sayın uzmanım önce fikrinize emeğinize sağlık.

Verdiğiniz kodları yukardan aşağıya doğru düşünecek olursak
1 ve 3 sorun yok
2 ve 4 te minik sorun var.
Onlar da düzeltildi mi tamamdır

2 nolu kod, örnek2

ornek2.xls dosyasını indir - download

ornek2.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

4 nolu kod, örnek4

ornek4.xls dosyasını indir - download

ornek4.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

Korhan Ayhan · 27 Mayıs 2020

Kopyala-Yapıştır kurbanı oluyoruz.

Revize ettim. Tekrar deneyiniz.

izcik · 28 Mayıs 2020

Korhan Ayhan' Alıntı:
Kopyala-Yapıştır kurbanı oluyoruz.

Revize ettim. Tekrar deneyiniz.

Sayın uzmanım
Yukardan aşağıya 1,2,3,4 olarak düşünecek olursak hepsi çok güzel oldu. Elinize sağlık. Sadece 1 de çok minik bir düzeltme yapınca bu konuyu neticelendirmiş olacağız

ornek1.xls dosyasını indir - download

ornek1.xls dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

Korhan Ayhan · 28 Mayıs 2020

Aşağıdaki gibi olabilir.

3 hücreden oluşan isimler için döngü içindeki aşağıdaki satırlardan 1 adet daha eklerseniz sonuç alırsınız.

Kod:

        Say = Say + 1
        Liste(Say, 1) = Empty

C++:

Option Explicit

Sub Concanate_Name_Surname_Step_2()
    Dim Veri As Variant, Son As Long, X As Long, Say As Long

    Son = Cells(Rows.Count, 1).End(3).Row
    Veri = Range("A2:A" & Son).Value

    Range("B2:B" & Rows.Count).Clear
   
    ReDim Liste(1 To Rows.Count, 1 To 1)
   
    For X = LBound(Veri) To UBound(Veri) Step 2
        Say = Say + 1
        Liste(Say, 1) = Veri(X, 1) & " " & Veri(X + 1, 1)
        Say = Say + 1
        Liste(Say, 1) = Empty
    Next

    If Say > 0 Then Range("B2").Resize(Say, 1) = Liste

    MsgBox "Ad-Soyadlar birleştirilmiştir.", vbInformation
End Sub

İsimleri tek hücrede birleştirme

izcik

ornek1.xls dosyasını indir - download

ornek2.xls dosyasını indir - download

Korhan Ayhan

Administrator

izcik

Korhan Ayhan

Administrator

mustafa1205

Korhan Ayhan

Administrator

izcik

izcik

Korhan Ayhan

Administrator

izcik

ornek2.xls dosyasını indir - download

ornek4.xls dosyasını indir - download

Korhan Ayhan

Administrator

izcik

ornek1.xls dosyasını indir - download

Korhan Ayhan

Administrator