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

[Believing]

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,

 

[Ziynettin]

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]

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]

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]

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]

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.

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]

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,