tek hücre içindeki satırları satırlara genişletmek yardım!

Katılım
11 Nisan 2007
Mesajlar
125
Excel Vers. ve Dili
excel=2016
türkçe
Altın Üyelik Bitiş Tarihi
01-07-2024
ilk olarak tüm excel.web.tr üye ve kullanıcılarının geçmiş bayramı kutlu olsun..

arkadaşlar benim sorunum bir tabloyu pdf den excel'e çevirdim, çeviri programı hücrelerin içini satırlar olarak algıladığından, hücrelerin içi alt+enter yapılarak tek hücrede satırlar oluşturulmuş gibi, benim isteğim a1, b1 ve c1 hücrelerinin içeriklerini bozulmadan dağıtmak yardımcı olursanız sevinirim. örnekte daha iyi açıkladım sanrımı.
 

Ekli dosyalar

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,471
Excel Vers. ve Dili
Office 2010 & 2013 tr
Merhaba,
Kod:
Sub böl()
Application.ScreenUpdating = False
Sut = 1
For r = 1 To 3
Sat = 1
    For x = Sat To Cells(65536, Sut).End(3).Row
        Do
        Cells(Sat + 1, Sut).Insert Shift:=xlDown
        Metin = Cells(Sat, Sut)
        Uzn2 = Len(Metin)
        ilk = Split(Cells(Sat, Sut), Chr(10))
        Cells(Sat, Sut) = ilk
        Uzn1 = Len(Cells(Sat, Sut)) + 2
        SonMetin = Mid(Metin, Uzn1, Uzn2)
        Cells(Sat + 1, Sut) = SonMetin
        Sat = Sat + 1
        Loop While SonMetin <> ""
    Cells(Sat, Sut).Delete Shift:=xlUp
    Next
Sut = Sut + 1
Next
End Sub
NOT: Tablonun uzunluğuna göre ayırma işleminin süresi daha da uzayabilir.
 

Ekli dosyalar

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. CONANFORCE pdf den excel'e çevirdiğiniz dosyadan bir örnek dosya ekleyebilirmisiniz, excele dönüştürürken satır satır alma imkanının olup olmadığını denemek istiyorum. Teşekkürler.
 
Katılım
11 Nisan 2007
Mesajlar
125
Excel Vers. ve Dili
excel=2016
türkçe
Altın Üyelik Bitiş Tarihi
01-07-2024
Sn. CONANFORCE pdf den excel'e çevirdiğiniz dosyadan bir örnek dosya ekleyebilirmisiniz, excele dönüştürürken satır satır alma imkanının olup olmadığını denemek istiyorum. Teşekkürler.

ilk olarak sayın leumruk ilginize teşekkür ederim fakat yaptığınıf makro tam olarak isteğimi karşılamıyor ben ikinci sayfadaki gibi her birinin karşılıklı gelmesini istiyordum.

sayın tahsinanarat sizin isteğiniz dosyayıda ekledim. ben 2009 dgs klavuzunun 3 nolu tablosunu çeviriyorudum çevirdiğim excel ekte pdf si de link olarak ekledim karşılaştırırsanız sevinirim.

http://www.osym.gov.tr/dosyagoster.aspx?DIL=1&BELGEANAH=34063&DOSYAISIM=TABLO3.pdf
 

Ekli dosyalar

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,167
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Çok ilginç

Bende göndermiş olduğunuz pdf uzantılı dosyayı excele attığımda sizin istediğiniz gibi satır satır attığını gördüm.
ABBYY Fine Reader 7.0 ile Dönüştürdüğüm dosyanın bir kısmı ekte.
Ayrıca sizin örnek dosyanında istediğiniz şekle dönüştürülmesi için yazılacak olan makro da ayrı bir olay, bir gün mutlaka bu şekilde de lazım olabilir. Yapacak olan arkadaşlara şimdiden teşükkürler.
 

Ekli dosyalar

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,471
Excel Vers. ve Dili
Office 2010 & 2013 tr
Merhaba,
Kod:
Sub Sat_Ayır()
Application.ScreenUpdating = False
Range("a1:c" & [a65536].End(3).Row).Borders.LineStyle = xlNone

For x = [b65536].End(3).Row To 1 Step -1

Sat = x
Satır_Sayısı1 = Len(Cells(x, "b")) - Len(WorksheetFunction.Substitute(Cells(x, "b"), Chr(10), ""))
Satır_Sayısı2 = Len(Cells(x, "c")) - Len(WorksheetFunction.Substitute(Cells(x, "c"), Chr(10), ""))
Satır_Sayısı = Satır_Sayısı1

If Satır_Sayısı1 < Satır_Sayısı2 Then Satır_Sayısı = Satır_Sayısı2

For y = 1 To Satır_Sayısı
Rows(Sat + 1).Insert Shift:=xlDown
Rows(Sat + 1).RowHeight = 13
Rows(Sat).RowHeight = 13

Metin1 = Cells(Sat, "a")
Metin2 = Cells(Sat, "b")
Metin3 = Cells(Sat, "c")

Mtn_Uzn1 = Len(Metin1)
Mtn_Uzn2 = Len(Metin2)
Mtn_Uzn3 = Len(Metin3)

İlk_Satır1 = Split(Cells(Sat, "a"), Chr(10))
İlk_Satır2 = Split(Cells(Sat, "b"), Chr(10))
İlk_Satır3 = Split(Cells(Sat, "c"), Chr(10))

Cells(Sat, "a") = İlk_Satır1
Cells(Sat, "b") = İlk_Satır2
Cells(Sat, "c") = İlk_Satır3

İlk_Sat_Uzn1 = Len(Cells(Sat, "a")) + 2
İlk_Sat_Uzn2 = Len(Cells(Sat, "b")) + 2
İlk_Sat_Uzn3 = Len(Cells(Sat, "c")) + 2

Son_Metin1 = Mid(Metin1, İlk_Sat_Uzn1, Mtn_Uzn1)
Son_Metin2 = Mid(Metin2, İlk_Sat_Uzn2, Mtn_Uzn2)
Son_Metin3 = Mid(Metin3, İlk_Sat_Uzn3, Mtn_Uzn3)

Cells(Sat + 1, "a") = Son_Metin1
Cells(Sat + 1, "b") = Son_Metin2
Cells(Sat + 1, "c") = Son_Metin3
            
Sat = Sat + 1

Next
Set Aralık = Range(Cells(x, "a"), Cells(x + Satır_Sayısı, "c"))
Aralık.Borders(xlEdgeLeft).LineStyle = xlContinuous
Aralık.Borders(xlEdgeTop).LineStyle = xlContinuous
Aralık.Borders(xlEdgeBottom).LineStyle = xlContinuous
Aralık.Borders(xlEdgeRight).LineStyle = xlContinuous
Next
End Sub
NOT: Bir önceki kodlardan çok daha hızlı çalışıyor. Tek döngüyle işlemi tamamladım. Ayırma formatını istediğiniz şekle çevirdim.
 

Ekli dosyalar

Son düzenleme:
Katılım
11 Nisan 2007
Mesajlar
125
Excel Vers. ve Dili
excel=2016
türkçe
Altın Üyelik Bitiş Tarihi
01-07-2024
ilginize ve yardımlarınıza çok teşekkür ederim. iyi çalışmaar.
 
Üst