Soru Farklı iki sütun verilerini farklı bir sütunda birleştirmek

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Sayın Formdaş arkadaşlar,

Ekteki örnek çalışmanın "Q" sütunu oda numarası, "R" sütunu ise isimlerden oluşmaktadır.
"Q:R" aralığını aralarında boşluk olacak şekilde "H" sütununda birleştirmek istiyorum.
Bu işlemi birleştir formülü ile yapabiliyorum. Fakat birleştireceğim sayfadaki veriler 100.000 satır üzerinde olup her yeni gün artmaktadır. Bu sebep ile birleştirme işlemin kod yardımı ile yapmak durumundayım.
Konu hakkında çok değerli yardımlarınızı rica ediyorum.

Saygılarımla,
 

Ekli dosyalar

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Kod:
Sub birlestir()
    son = Cells(Rows.Count, "Q").End(3).Row
    If son < 2 Then Exit Sub
    a = Range("Q2:R" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        b(i, 1) = a(i, 1) & " " & a(i, 2)
    Next i
    Range("H2:H" & Rows.Count).ClearContents
    Range("H2:H" & Rows.Count).ClearFormats
    [H2].Resize(UBound(a)).Value = b
    [H2].Resize(UBound(a)).Borders.Color = rgbSilver
    MsgBox "İşlem tamam...", vbInformation
End Sub
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Sayın Ziynettin,

Affınıza sığınarak bir düzeltme yapmamız mümkün müdür?
"R" sütununa veri yoksa birleştirme işlemini yapmasın.
"R" sütununda veri olan satırlara ait işlem yapmasını sağlamak mümkün müdür?

Saygılarımla,
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Kod:
Sub birlestir()
    son = Cells(Rows.Count, "Q").End(3).Row
    If son < 2 Then Exit Sub
    a = Range("Q2:R" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        If Not IsEmpty(a(i, 2)) Then
            say = say + 1
            b(say, 1) = a(i, 1) & " " & a(i, 2)
        End If
    Next i
    Range("H2:H" & Rows.Count).ClearContents
    Range("H2:H" & Rows.Count).ClearFormats
    [H2].Resize(say).Value = b
    [H2].Resize(say).Borders.Color = rgbSilver
    MsgBox "İşlem tamam...", vbInformation
End Sub
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Ziynettin bey,
Birleştirilen verileri "H2" de itibaren listelemektedir.
Birleştirilecek olan her satır yine kendisine ait satırın "H" sütununda birleştirilecektir.
Her satır bilgisi birleştirilmeyecektir. Birleştirilecek olan satır bilgileri "R" sütununa işlenecektir.
Örneğin; R533 hücresine veri girilince birleştirme aynı satırda "H533" hücresinde yapılmalıdır.
Aralarda veri bulunmayan satırlar olacaktır. Bu boş satırlara ait "H" hücrelerindeki mevcut korunarak, "R" sütunu hücrelerinde verileri olan hücreler birleştirilecektir.

Saygılarımla,
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,104
Excel Vers. ve Dili
office2010
Sorunuzdan anladığım; R sütununda veri varsa Q ile R sütunlarını H sütununa birleştir, R sütununda veri yoksa H sütunu olduğu gibi kalsın.

Kod:
Sub birlestir()
    son = Cells(Rows.Count, "Q").End(3).Row
    If son < 2 Then Exit Sub
    a = Range("H2:R" & son).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        say = say + 1
        If Not IsEmpty(a(i, 11)) Then
            b(say, 1) = a(i, 10) & " " & a(i, 11)
         Else
            b(say, 1) = a(i, 1)
        End If
    Next i
'    Range("H2:H" & Rows.Count).ClearContents
'    Range("H2:H" & Rows.Count).ClearFormats
    [H2].Resize(say).Value = b
    [H2].Resize(say).Borders.Color = rgbSilver
    MsgBox "İşlem tamam...", vbInformation
End Sub
 

Believing

Altın Üye
Katılım
19 Mayıs 2013
Mesajlar
698
Excel Vers. ve Dili
Office Pro 2019 TR 32 Bit
Windows Pro 10 TR 64 Bit
Sayın Ziynettin,

Ellerinize ve emeğinize sağlık.
ALLAH sizden ve sevdiklerinizden razı olsun.
Hakkınızı helal ediniz lütfen.

Saygılarımla,
 
Üst