A1 deki veriyi baklava biçiminde hücrelere dağıtma

Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
Arkadaşlar,
ben a1 sutununa bir değer girdiğimde o yazdığım metni baklava şeklinde her bir hücrede tek tek harfler yazıcak bunun için yardım edermisiniz

İyi çalışmalar
 
Katılım
11 Mart 2006
Mesajlar
597
Excel Vers. ve Dili
ms office 2010 ev
ms office 2007 iş
Altın Üyelik Bitiş Tarihi
08.01.2019
sn remzi1991 PARÇAAL fonksiyonuyla bu işlemi yapabilirsiniz. ayrıca dosya ektedir.
 
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
sayın yucel istediğim tam olarak bu değil
ben aşağıda eklediğim dosya gibi gözüksün istiyorum
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,698
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

12 karaktere kadar kontrol eden bir örnek dosya hazırladım. İncelermisiniz.
 
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
sayın Korhan Ayhan

ilginiz ve yardımınız için teşekkürler
 
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
bu işlemi for döngüsüyle nasıl yapabiliriz
daha kısa olsun diye
 
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
yok mu bu konuda hiç bir fikri olann
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,294
Excel Vers. ve Dili
Ofis 365 Türkçe
Baklava Tipi Yazdırma

Merhaba,

Kısa sürede hazırladığım kodları sunuyorum. Algoritmayı iyi düşününce kodlar daha kısa olabilir, eee zaman sorunu, idare ediniz artık.

Kodları deneyiniz, umarım yanlış çalışmaz.

Kod:
Sub BaklavaGibiDose()
Application.ScreenUpdating = False
Range("B1:Z100").ClearContents
Adet = Application.WorksheetFunction.RoundUp(Len([A1]) / 4, 0) + 1
BasKolon = Adet + 1
BasSatır = 1
For i = 1 To Adet
    Cells(BasSatır, BasKolon) = Mid([A1], i, 1)
    BasSatır = BasSatır + 1
    BasKolon = BasKolon + 1
Next i
BasKolon = BasKolon - 2
For i = i To i + Adet - 2
    Cells(BasSatır, BasKolon) = Mid([A1], i, 1)
    BasSatır = BasSatır + 1
    BasKolon = BasKolon - 1
Next i
BasSatır = BasSatır - 2
For i = i To i + Adet - 2
    Cells(BasSatır, BasKolon) = Mid([A1], i, 1)
    BasSatır = BasSatır - 1
    BasKolon = BasKolon - 1
Next i
BasKolon = BasKolon + 2
For i = i To i + Adet - 3
    Cells(BasSatır, BasKolon) = Mid([A1], i, 1)
    BasSatır = BasSatır - 1
    BasKolon = BasKolon + 1
Next i
Application.ScreenUpdating = True
End Sub
 

Ekli dosyalar

Son düzenleme:
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
sayın nejdet yeşertener

gerçekten muhteşem ve tam dilediğim gibi olmuş elinize ve emeğinize teşekkürler.cok sağolun varolun
 
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
hocam bu arkadasın gonderdıgı eklentıyı nasıl alabılırım sızde yedegı falan var mıdır? arkds uyelıgnı kaldırdıgı ıcın ındırılmıo sanırım?
 
Katılım
25 Ekim 2007
Mesajlar
64
Excel Vers. ve Dili
2003 türkçe
acil lazım ilgilenirseniz teşekkur ederım. . bu hafta sonuna kadar. .
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,294
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

10. mesajdaki kodlar ve dosya yeniden eklendi.
Bakan arkadaşlar için dosyaya erişim sorunu olmasın.
 
Üst