KİTAP ADLARININ HER BİRİNİ BİR SATIRA YAZDIRMA

Erdinç FIRTINA

Altın Üye
Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
15-05-2026
Değerli Forum Üyeleri ,

E sütununda yer alan satırlardaki kitap adlarını, F sütunundan başlayarak her bir kitabın adı bir hücrede yer alacak şekilde ayrıştırarak yazdırmak istiyorum.
E SÜTUNU F SÜTUNU G SÜTUNU H Sütunu
Okulum Başladı,Okuma ve Yazma,Matematik, Okulum Başladı Okuma ve Yazma Matematik

Örnek dosyam ilişikte sunulmuştur.

Yardımlarınız için şimdiden teşekkürler...
 

Ekli dosyalar

Cengiz Demir

Altın Üye
Katılım
29 Haziran 2018
Mesajlar
605
Excel Vers. ve Dili
Office 365 TR (32 Bit)
Altın Üyelik Bitiş Tarihi
05-04-2025
Her kitap adının arasında standart olarak virgül bulunacaksa;
Kitap adı sütununu başka bir yere kopyalayın.
İlgili sütun yada hücreleri seçip, veri / metni sütunlara dönüştür / sınırlandırılmış ve virgül seçip tamam yapın.
Kitap adları sütunlara ayrılacaktır. Daha sonra tümünü kopyalayıp bir sütun sağa yapıştırırsınız.
Son olarak toplu kitap adlarına da ihtiyacınız varsa kopyaladığınız yerden tekrar ilgili sütuna kopyalarsınız. :)
 

Erdinç FIRTINA

Altın Üye
Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
15-05-2026
Sayın Cengiz Demir,
Öncelikle yardımınız için teşekkür ederim.
Ancak, söylediğiniz yöntemle ayrıştıramadım. Ayrıca bir kod yardımıyla olabilirse çok daha iyi olacak.
 

Ziynettin

Destek Ekibi
Destek Ekibi
Katılım
18 Nisan 2008
Mesajlar
1,106
Excel Vers. ve Dili
office2010
Alternatif.

Kod:
Sub ayir()
Set dc = CreateObject("scripting.dictionary")
son = Cells(Rows.Count, 5).End(3).Row
If son < 2 Then MsgBox "tablo veriniz yok.", vbExclamation: Exit Sub
a = Range("E1:E" & son).Value
x = UBound(a)
ReDim b(1 To x - 1, 1 To Columns.Count)
    For i = 2 To x
        deg = Split(a(i, 1), ",")
        For j = 0 To UBound(deg)
            b(i - 1, j + 1) = deg(j)
            dc(i - 1) = j
        Next j
    Next i
If dc.Count > 0 And Application.Max(dc.items) > 0 Then
    [F2].Resize(x - 1, Application.Max(dc.items) + 1) = b
    MsgBox "İşlem bitti.", vbInformation
Else
    MsgBox "İşlem yok.", vbCritical
End If
End Sub
 

Erdinç FIRTINA

Altın Üye
Katılım
14 Şubat 2007
Mesajlar
400
Excel Vers. ve Dili
excel 2003 türkçe
Altın Üyelik Bitiş Tarihi
15-05-2026
Sayın Tevfik Kursun, Sayın Ziynettin;

Yardımlarınız için çok çok teşekkür ederim. Elinize, yüreğinize sağlık.

Sizlerin ve tüm forum üyelerinin yeni yılı kutlu olsun. Mutlu yıllar...
 
Üst