Virgül sonrasını bir alt satıra yazma.

[Rainbows]

Merhaba arkadaşlar benim bir tablom var bir kolonda birden fazla data var. ben bunların ayrı kolonlarda olmasını istiyorum. mesela a2 kolonunda virgül ile ayrılmıs

"Amoi 3Skype, Amoi 8507 (Berlin), Amoi 8512, Amoi 8517, Amoi Chicago, Amoi M636, Amoi MD 900"
6 cümleli bir yazı var ben bunları alt alt nasıl alabilirim.

örnek tablo ektedir. tesekkürler.

 

[Mahir64]

Merhaba arkadaşlar benim bir tablom var bir kolonda birden fazla data var. ben bunların ayrı kolonlarda olmasını istiyorum. mesela a2 kolonunda virgül ile ayrılmıs

"Amoi 3Skype, Amoi 8507 (Berlin), Amoi 8512, Amoi 8517, Amoi Chicago, Amoi M636, Amoi MD 900"
6 cümleli bir yazı var ben bunları alt alt nasıl alabilirim.

örnek tablo ektedir. tesekkürler.

Merhaba
Veri / Metni Sütunlara Dönüştür / Sınırlandırılmış / Diğer / ","
seçeneği işinizi görecektir.

 

[Rainbows]

Bunu alt kolonlara yazma sansımız var mı?

 

[Ömer]

Bunu alt kolonlara yazma sansımız var mı?

Merhaba,

Örnek olarak A2,A3 ve A4 hücrlerinin olmasını istediğiniz formatını Sayfa2 de hazırlayıp yeni bir dosya eklermisiniz..

.

 

[Rainbows]

Ekledim. sayda2 de belirttim nasıl olması gerektigini

 

[Ömer]

Tabloyu değiştirmişsiniz ve ayrıca A2,A3 ve A4 için örneklemenizi rica etmiştim.Sadece A2 yi örneklemişsiniz.

Bunun için de görmek istediğimi göremedim.

------------------------------------------------------------------------------------------

A3 ü diğer sayfada A1 ve A2 ye yazdınız. A4 için diğer sayfadan A3 denmi başlayarak yazacak.

.

 

[Rainbows]

Peki ekledim sizin istediginiz gibi

 

[Ömer]

Bu şekilde deneyiniz..

Sub Ayristir()
 
Dim Sv As Worksheet, i As Long, j As Integer
Dim Adet As Long, sut As Integer, sat As Long
Dim deg
 
Set Sv = Sheets("Sheet1")
Application.ScreenUpdating = False
Sheets("Sheet2").Select
Cells.ClearContents
 
Adet = Rows.Count - 1: sut = 1: sat = 0
For i = 1 To Sv.Cells(Rows.Count, "A").End(xlUp).Row
    deg = Split(Sv.Cells(i, "A"), ",")
    For j = 0 To UBound(deg)
        sat = sat + 1
        If sat > Adet Then
            sat = 1
            sut = sut + 1
            If sut > Columns.Count Then
                MsgBox "Satır sayısını ayarlayamadınız, sütun taşacak " & _
                "ve hata verecek, bu yüzden duruyorum"
                Exit Sub
            End If
        End If
        Cells(sat, sut) = deg(j)
    Next j
Next i
Application.ScreenUpdating = True
End Sub

 

[Rainbows]

tesekkürler.