Excel'de Alt Alta Satırları Yan Yana Virgülle Ayırma

Excelde alt atla satırları tek hücrede virgülle ayrılmış olarak kolayca düzenleyebilirsiniz.

Nasıl Yapılır?

1- Aşağıdaki kodu , ilgili sekmenin üzerinde sağ tuş yaparak ekleyebilirsiniz.

2- Daha sonrasında açılan pencereye kodu ekleyip Run tıklatmanız gerekiyor.

3- Sonuç aşağıdaki gibi görüntülenmesi gerekiyor.

Kod

Sub birleştir()

son = Cells(65536, 1).End(xlUp).Row

For i = 1 To son

ad = Cells(i, 1)

[b1] = [b1] + ad & ","

Next

End Sub

Virgülle ayrılmış değerleri satırlara dönüştürme

Yukarıdaki işlemin tersi olarak aşağıdaki kodu kullanabilirsiniz. Bu kod tam olarak virgülle ayrılmış  bir değeri (tek satırı) satırlara alt alta yazdırmanıza yarayacaktır.

Kod

Sub SplitAll()
Dim xRg As Range
Dim xRg1 As Range
Dim xCell As Range
Dim I As Long
Dim xAddress As String
Dim xUpdate As Boolean
Dim xRet As Variant
On Error Resume Next
xAddress = Application.ActiveWindow.RangeSelection.Address
Set xRg  = Application.InputBox("Please select a range", "Kutools for Excel", xAddress, , , , , 8)
Set xRg  = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
If xRg Is Nothing Then Exit Sub
If xRg.Columns.Count > 1 Then
MsgBox "You can't select multiple columns", , "Kutools for Excel"
Exit Sub
End If
Set xRg1 = Application.InputBox("Split to (single cell):", "Kutools for Excel", , , , , , 8)
Set xRg1 = xRg1.Range("A1")
If xRg1 Is Nothing Then Exit Sub
xUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For Each xCell In xRg
xRet = Split(xCell.Value, ",")
xRg1.Worksheet.Range(xRg1.Offset(I, 0), xRg1.Offset(I + UBound(xRet, 1), 0)) = Application.WorksheetFunction.Transpose(xRet)
I = I + UBound(xRet, 1) + 1
Next
Application.ScreenUpdating = xUpdate
End Sub