Alt alta sayıları yatay yapma ama!

[trborakurkcu]

merhaba arkadaşlar şöyle bir sorum var
Aşağıdaki sayılar alt alta boşluksuz 2,3 veya daha fazla da olabilir bu sayılar yatay eklensin ama sayı boşluk sayı boşluk gibiyse
sayılar alt alta eklensin ama boşluksuz olsun umarım anlatabilmişimdir yardımlarını bekliyorum

örnek a1 hücresi rakam
a2 hücresi rakamsa yanyana olsun

a5 hücresi rakam
a6 hücresi rakam
a7 hğcresi rakamsa yanyana olsun

ama

a5 rakam
a6 boş
a7 rakam
a8 boş
a9 rakam
a10 boş şeklindeyse alt alta olsun rakamlar ama rakam boşluk rakam değilde rakam rakam şeklinde

 

[ÖmerFaruk]

Sorunuzu ve cözümünü içeren örnek dosya hazırlayıp harici yükleme sitelerine yükleyerek linkini buraya kopayalayabilirsiniz.

 

[trborakurkcu]

Hata indir

Hata

www.dosyaupload.com

a hücresindeki veriler c d e f deki gibi otomatik olacak istediğim

 

[ÖmerFaruk]

Sub Yatay()
Kol = 3 'Sonucları C sütunundan başlamak için belirttim. Arzu ederseniz değiştirsiniz. Asla 1 yapmayın
Sat = 1 'Sonucları 1. satırdanbaşlamak için belirttim. Arzu ederseniz değiştirsiniz
For i = 1 To Range("A" & Rows.Count).End(3).Row
    If Cells(i, 1) = "" Then
        Kol = 3: Sat = Sat + 1
    Else
        Cells(Sat, Kol) = Cells(i, 1)
        Kol = Kol + 1
    End If
Next i
End Sub

 

[trborakurkcu]

hocam ben bu kodları nereye yazacağım anlamadım

 

[ÖmerFaruk]

Dosyanıza eklenmiş hali ekte.
Bunun nasıl yapıldığını öğrenmeye çalışmalısınız.

https://dosya.co/xz6d0w47hufk/YatayYap.xlsm.html

 

[52779]

Selamlar,

Ben de 2 adet yardımcı kolon kullanarak formülle çözmeye çalıştım. Dosya ektedir... İncelersiniz... (Şahsi fikrim, Makro ile çözüm daha etkili..)

Sayilar_DikeydenYataya.xlsx dosyasını indir - download

Sayilar_DikeydenYataya.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s7.dosya.tc

Açıklama :
Dosyada,
** A1 : A100 aralığında SAYI - METİN ve BOŞ hücreler vardır.
** SAYILAR Yatay satırlara yazdırılıyor. Her Boş ya da Metinden sonra gelen sayı bir alt satırın ilk elemanı oluyor. Bunu takip eden Sayılar ise aynı satırda sağ tarafa doğru kolonlara yazdırılıyor.

Formülle Çözüm :
İki adet yardımcı kolon kullanılarak listeleme yapıldı
1. Yardımcı kolon : B1 : B100
Boşluk ya da Metinlere göre sayı olanlara sıra no verildi.
2. Yardımcı kolon : C1 : C100
Sıra numaralarına göre listede bulunacak adresin R1C1 cinsinden yazdırılması...

Listeleme :
C1 : C100 aralığındaki adreslere göre İNDİS - KAÇINCI işlevleri kullanılarak Listeleme yapıldı...

 

[trborakurkcu]

pardon eksik bilgi verdim alt alta rakamlarda rakam 1 boşluk rakam değilde rakam 2 boşluk rakam şeklindeymiş hepsi

alt alta 2 boşluk olduğu için bu seferde macro alt alta rakam 1 boşluk yapıyor

 

[ÖmerFaruk]

Boşluk sayısı ne olursa olsun.
Aşağıdaki kodlarla değiştirin.

Sub Yatay()
sonS = Range("A1").SpecialCells(xlLastCell).Row
SonK = Range("A1").SpecialCells(xlLastCell).Column
If sonS < 2 Then sonS = 2
Range("B1", Cells(sonS, SonK)).ClearContents
Kol = 3 'Sonucları C sütunundan başlamak için belirttim. Arzu ederseniz değiştirsiniz. Asla 1 yapmayın
Sat = 1 'Sonucları 1. satırdanbaşlamak için belirttim. Arzu ederseniz değiştirsiniz
For i = 1 To Range("A" & Rows.Count).End(3).Row
    If Cells(i, 1) = "" Then
        If Cells(i + 1, 1) <> "" Then Kol = 3: Sat = Sat + 1
    Else
        Cells(Sat, Kol) = Cells(i, 1)
        Kol = Kol + 1
    End If
Next i
End Sub

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Transposed_Data_Transfer()
    Dim My_Area As Range, My_Cell As Range, My_Row As Long
    
    Set My_Area = Range("A:A").SpecialCells(xlCellTypeConstants, 1)
    
    Range("C:XFD").ClearContents
    
    My_Row = 1
    
    For Each My_Cell In My_Area.Areas
        Cells(My_Row, 3).Resize(, My_Cell.Count) = Application.Transpose(My_Cell)
        My_Row = My_Row + 1
    Next
    
    MsgBox "Your transaction is complete."
End Sub