• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Harflere ayırma

Katılım
6 Aralık 2004
Mesajlar
82
Arkadaşlar klasör arkasına yapıştırma yapacağız. Mükellef isimlerimizi alt alta harf harf yazmak istiyoruz. bunu yapmak bir yöntem var mı?

ekli dosyada sayfa 1 de yazılanları sayfa 2 deki gibi yazmak istiyorum. Böyle bişey yok ise sayfa 1 dekini sayfa 3 deki gibi dikey nasıl yazabiliriz. en basit yol ile..

simdiden tesekkürler...
 

Ekli dosyalar

sayfa1'i kopyala sonra sağ clik ile özel yapıştırı seç. Çıkan ekranda en alt sağda "işlemi tersine çevir (ing. transpose) var onu seç ve yapıştır de sayfa 3 deki dibi olur
 
Dört sütunu ben formülledim, sağa doğru diğer sütunları formüleri çekerek ve değiştirerek siz tamamlayın.
 

Ekli dosyalar

Arkadaşlar klasör arkasına yapıştırma yapacağız. Mükellef isimlerimizi alt alta harf harf yazmak istiyoruz. bunu yapmak bir yöntem var mı?

ekli dosyada sayfa 1 de yazılanları sayfa 2 deki gibi yazmak istiyorum. Böyle bişey yok ise sayfa 1 dekini sayfa 3 deki gibi dikey nasıl yazabiliriz. en basit yol ile..

simdiden tesekkürler...

Merhaba,

İki sayfadaki istediğiniz de yapılabilir.

Alternatif olsun.

Kod:
[COLOR=darkgreen]'Sayfa2 İçin[/COLOR]
Sub Harf_Ayir()
 
    Dim d() As String, S1 As Worksheet, i As Long
    Dim Uz As Integer, j As Integer
 
    Set S1 = Sheets("Sayfa1")
 
    Sheets("Sayfa2").Select
    Rows("3:" & Rows.Count).ClearContents
 
    For i = 1 To S1.Cells(Rows.Count, "D").End(xlUp).Row
        Uz = Len(S1.Cells(i, "D"))
        ReDim d(1 To Uz)
        For j = 1 To Uz
            d(j) = Mid(S1.Cells(i, "D"), j, 1)
        Next j
        Cells(3, i) = S1.Cells(i, "C")
        Cells(4, i).Resize(Uz, 1) = Application.WorksheetFunction.Transpose(d)
    Next i
 
End Sub
[COLOR=darkgreen]'[/COLOR]
[COLOR=darkgreen]'Sayfa3 İçin[/COLOR]
Sub Ters_Cevir()
 
    Dim son As Long, S1 As Worksheet
 
    Set S1 = Sheets("Sayfa1")
    son = S1.Cells(Rows.Count, "D").End(xlUp).Row
 
    Sheets("Sayfa3").Select
    Rows("3:" & Rows.Count).ClearContents
 
    S1.Range("C1:D" & son).Copy
    Range("A3").PasteSpecial xlPasteAll, xlNone, , True
 
    Rows("4:" & Rows.Count).Orientation = -90
 
End Sub

.
 
Dört sütunu ben formülledim, sağa doğru diğer sütunları formüleri çekerek ve değiştirerek siz tamamlayın.

teşekkür ederim vermiş olduğunuz bilgi için...
sağa doğru çekince ya da alta doğru çekince çekilen formülü olduğu gibi kopyalıyor. bi sonraki satırı getirmiyor. tek tek el ilemi düzeltmem gerekecek.
 
Merhaba,

İki sayfadaki istediğiniz de yapılabilir.

Alternatif olsun.

Kod:
[COLOR=darkgreen]'Sayfa2 İçin[/COLOR]
Sub Harf_Ayir()
 
    Dim d() As String, S1 As Worksheet, i As Long
    Dim Uz As Integer, j As Integer
 
    Set S1 = Sheets("Sayfa1")
 
    Sheets("Sayfa2").Select
    Rows("3:" & Rows.Count).ClearContents
 
    For i = 1 To S1.Cells(Rows.Count, "D").End(xlUp).Row
        Uz = Len(S1.Cells(i, "D"))
        ReDim d(1 To Uz)
        For j = 1 To Uz
            d(j) = Mid(S1.Cells(i, "D"), j, 1)
        Next j
        Cells(3, i) = S1.Cells(i, "C")
        Cells(4, i).Resize(Uz, 1) = Application.WorksheetFunction.Transpose(d)
    Next i
 
End Sub
[COLOR=darkgreen]'[/COLOR]
[COLOR=darkgreen]'Sayfa3 İçin[/COLOR]
Sub Ters_Cevir()
 
    Dim son As Long, S1 As Worksheet
 
    Set S1 = Sheets("Sayfa1")
    son = S1.Cells(Rows.Count, "D").End(xlUp).Row
 
    Sheets("Sayfa3").Select
    Rows("3:" & Rows.Count).ClearContents
 
    S1.Range("C1:D" & son).Copy
    Range("A3").PasteSpecial xlPasteAll, xlNone, , True
 
    Rows("4:" & Rows.Count).Orientation = -90
 
End Sub

.

teşekkür ederim kodlar ile pek aram iyi degil sayfa iki için yazmış olduğunuz formülü kopyalayıp kod sayfasına yapıştırdım kaydettim ve çıktım hiç bişey olmadı. yani anlayacağınız beceremedim. :)
 
teşekkür ederim kodlar ile pek aram iyi degil sayfa iki için yazmış olduğunuz formülü kopyalayıp kod sayfasına yapıştırdım kaydettim ve çıktım hiç bişey olmadı. yani anlayacağınız beceremedim. :)

2 ayrı sayfa için makrolu çözümlerin dosyası ektedir.

Eğer formülle çözüm istiyorsanız:

Sayfa2 A4 hücresine aşağıdaki formülü yazıp yana ve alt hücrelere dilediğiniz kadar kopyalayın.

Kod:
=PARÇAAL(KAYDIR(Sayfa1!$D$1;SÜTUNSAY($A4:A4)-1;0);SATIRSAY(A$4:A4);1)
--------------------------------------------------------------------------------------------------------

Sayfa3 A4 hücresine aşağıdaki formülü yazıp yan hücrelere dilediğiniz kadar kopyalayın.

Kod:
=KAYDIR(Sayfa1!$D$1;SÜTUNSAY($A4:A4)-1;0)

4 çözümden size uygun olanı kullanırsınız.

.
 

Ekli dosyalar

2 ayrı sayfa için makrolu çözümlerin dosyası ektedir.

Eğer formülle çözüm istiyorsanız:

Sayfa2 A4 hücresine aşağıdaki formülü yazıp yana ve alt hücrelere dilediğiniz kadar kopyalayın.

Kod:
=PARÇAAL(KAYDIR(Sayfa1!$D$1;SÜTUNSAY($A4:A4)-1;0);SATIRSAY(A$4:A4);1)
--------------------------------------------------------------------------------------------------------

Sayfa3 A4 hücresine aşağıdaki formülü yazıp yan hücrelere dilediğiniz kadar kopyalayın.

Kod:
=KAYDIR(Sayfa1!$D$1;SÜTUNSAY($A4:A4)-1;0)

4 çözümden size uygun olanı kullanırsınız.

.

ömer bey çok teşekkür ediyorum. bu çok iyi oldu.
 
Geri
Üst