• DİKKAT

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

İsimleri tek hücrede birleştirme

  • Konbuyu başlatan Konbuyu başlatan izcik
  • Başlangıç tarihi Başlangıç tarihi
I

izcik

Katılım
18 Mayıs 2009
Mesajlar
1,184
Excel Vers. ve Dili
Excel 2016 Türkçe
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 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 s4.dosya.tc


...
 
B sütunu birleştirilmiş hücre şeklinde mi olacak?
 
Korhan Ayhan' Alıntı:
B sütunu birleştirilmiş hücre şeklinde mi olacak?
Genişletmek için tıkla ...

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
 
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
 
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.
 
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.
 
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.
Genişletmek için tıkla ...
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
 
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.
 
#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
 
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
Genişletmek için tıkla ...
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 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 www.dosya.tc
 
Kopyala-Yapıştır kurbanı oluyoruz.

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

Revize ettim. Tekrar deneyiniz.
Genişletmek için tıkla ...
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 www.dosya.tc
 
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst