Sutunları Birleştirme

[tahsinanarat]

Hücre biçemlerini bozmadan A,B,C Sutunlarını D Sutununda birleştirmek mümkünmüdür arkadaşlar.

 

[ynmcan]

Hücre biçemlerini bozmadan A,B,C Sutunlarını D Sutununda birleştirmek mümkünmüdür arkadaşlar.

=A1 & B1& C1 Formülünü kulana bilirsin
Örnek dosyayı inceleyin.

 

[tahsinanarat]

sn. ynmcany ilginiz için teşekkür ederim, ancak ben biçimlendirilmiş hücrelerin biçimlerini bozmadan birleştirmek istiyorum yani d sutununda kurulamak f (ab)trocknen şeklinde olmalıdırlar.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz? Umarım yeterlidir. Kodları biraz uzun oldu ama döngüyle kısaltmak olası.

Sub Birlestir()
Dim i As Long
Dim j As Integer
Application.ScreenUpdating = False
Range("D:D").Clear
For i = 3 To [A65536].End(3).Row
    Cells(i, "D") = Cells(i, "A") & " " & _
                   Cells(i, "B") & " " & _
                   Cells(i, "C")
    j = InStr(1, Cells(i, "D"), Cells(i, "A"), vbTextCompare)
    With Range("D" & i).Characters(j, Len(Cells(i, "A")))
        .Font.Color = Cells(i, "A").Font.Color
        .Font.Bold = Cells(i, "A").Font.Bold
        .Font.Italic = Cells(i, "A").Font.Italic
        .Font.Underline = Cells(i, "A").Font.Underline
        .Font.Size = Cells(i, "A").Font.Size
        .Font.Name = Cells(i, "A").Font.Name
    End With
 
    j = InStr(1, Cells(i, "D"), Cells(i, "B"), vbTextCompare)
    With Range("D" & i).Characters(j, Len(Cells(i, "B")))
        .Font.Color = Cells(i, "B").Font.Color
        .Font.Bold = Cells(i, "B").Font.Bold
        .Font.Italic = Cells(i, "B").Font.Italic
        .Font.Underline = Cells(i, "B").Font.Underline
        .Font.Size = Cells(i, "B").Font.Size
        .Font.Name = Cells(i, "B").Font.Name
    End With
 
    j = InStr(1, Cells(i, "D"), Cells(i, "C"), vbTextCompare)
    With Range("D" & i).Characters(j, Len(Cells(i, "C")))
        .Font.Color = Cells(i, "C").Font.Color
        .Font.Bold = Cells(i, "C").Font.Bold
        .Font.Italic = Cells(i, "C").Font.Italic
        .Font.Underline = Cells(i, "C").Font.Underline
        .Font.Size = Cells(i, "C").Font.Size
        .Font.Name = Cells(i, "C").Font.Name
    End With
 
Next i
End Sub

 

[tahsinanarat]

Diğer sorumun cevabı,

Hocam verdiğiniz mükemmel bir cevap, Elinize sağlık gerçekten harika olmuş. Çok çok teşekkür ediyorum.


İnanıyorum ki bir çok arkadaşımın aradığı sorunun cevabı, herkesin işine yarayacağını ümit ediyorum, elinize yüreğinize sağlık hocam. Saygılar sunuyorum.

 

[Seyit Tiken]

Şöyle bir hileye başvurduk, işe yarar mı?

 

[tahsinanarat]

İlginize çok teşekkür ederim sn. Seyit Tiken, Sn. Necdet hocam cevabını olması gerektiği şekilde vermiş umarım çoğu arkadaşın işine yarar. Kendisine bir kez daha teşekkür ediyorum.