Sutünları alt alta yapıştırma

[newton]

Merhaba,
Deprem kuvvetlerinin datası belli sitelerden notepad şeklinde indiriliyor.
Ancak belli başlı sismik hesap programlarına tanımlarken bu değerlerin belli sıralama halinde olması gerekiyor.
Aşağıda transpoze ettiğim ve 500 küsür sütun halinde dizilmiş ve her sütünda 5 farklı değerin olduğu bu sütunları sıralı halde dizmem gerekmektedir.Bununla ilgili önerebileceğiniz bir formül yada taktik varmı?
Cevabınız çok önemli, teşekkürler.
İLK HALİ
2.74E-05 2.14E-05 -4.38E-06 -1.41E-05 -1.36E-05 -8.16E-05
2.77E-05 1.64E-05 -5.58E-06 -1.39E-05 -4.88E-05 -1.06E-04
2.62E-05 1.60E-05 -1.98E-06 2.81E-06 -6.66E-05 -1.12E-04
2.48E-05 1.18E-05 -2.20E-06 9.44E-06 -6.43E-05 -5.89E-05
2.48E-05 3.49E-06 -8.03E-06 2.87E-06 -5.63E-05 3.85E-05

OLMASI GEREKEN

2.74E-05
2.77E-05
2.62E-05
2.48E-05
2.48E-05
2.14E-05
1.64E-05
1.60E-05
1.18E-05
3.49E-06
-4.38E-06
-5.58E-06
-1.98E-06
-2.20E-06
-8.03E-06
-1.41E-05
-1.39E-05
2.81E-06
9.44E-06
2.87E-06
-1.36E-05
-4.88E-05
-6.66E-05
-6.43E-05
-5.63E-05

 

[veyselemre]

Merhaba, aşağıdaki kodlarla B sütununa A sütunundaki verileri böler aktarır.

Sub bolAktar()
    veriler = [a1].CurrentRegion
    sat = 1
    For Each veri In veriler
        bol = Split(veri, " ")
        If UBound(bol) <> -1 Then
            Cells(sat, 2).Resize(UBound(bol)).Value = Application.Transpose(bol)
            sat = [b65536].End(3).Row + 1
        End If
    Next veri
End Sub

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu deneyiniz. Verileri A sütununa alt alta sıralar.

Sub KOD()
For a = 2 To Range("WWW1").End(xlToLeft).Column
    Range(Cells(1, a), Cells(5, a)).Copy Range("A65500").End(3).Offset(1)
    Range(Cells(1, a), Cells(5, a)).ClearContents
Next
End Sub

 

[Asri]

Merhaba,
Aşağıdaki kodu deneyiniz. Verileri A sütununa alt alta sıralar.

Sub KOD()
For a = 2 To Range("WWW1").End(xlToLeft).Column
    Range(Cells(1, a), Cells(5, a)).Copy Range("A65500").End(3).Offset(1)
    Range(Cells(1, a), Cells(5, a)).ClearContents
Next
End Sub

Vermiş olduğunuz kod aşağıdaki şekilde revize edildi.

Sub ensonsatir_ensonsutun()
  If WorksheetFunction.CountA(Cells) > 0 Then
     ensonsatir = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     ensonsutun = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
  Else
     ensonsatir = Rows.Count
     ensonsutun = Columns.Count
  End If
  
End Sub

Sub kolonlari_tek_kolon_yap()
   kolon = "A" & Rows.Count
   Call ensonsatir_ensonsutun
   For a = 2 To ensonsutun
      sutun = Cells(Rows.Count, a).End(xlUp).Row
      Range(Cells(1, a), Cells(sutun, a)).Copy Range(kolon).End(3).Offset(1)
      Range(Cells(1, a), Cells(sutun, a)).ClearContents
   Next
End Sub

Bu kodu ve 100 den fazla işlemi sağ tuş da eklenti olarak kullanmak isterseniz web sitemdeki eklentiyi kullanabilir siniz?

http://asriakdeniz.com/node/21

http://www.excel.web.tr/f133/excel-texttools-eklentisi-t124871.html

 

[newton]

Teşekkür ederim.
Şuan anlamaya ve denemeye çalışıyorum.
Size bildireceğim, emeğinize sağlık.

 

[bzace]

Merhabalar,
Formül ile alternatif olsun;

• Verilerimiz B1:J38 aralığında,
• A1:A38 1'den başlayarak sıra numarsı,

K1 hücresine;

=A1

K2 hücresine yazılıp aşağı doğru çoğaltılacak formül;

=EĞER(EĞERSAY(K$1:K1;K1)>=
   BAĞ_DEĞ_DOLU_SAY(İNDİS(B$1:J$38;
KAÇINCI(K1;A$1:A$38;);));K1+1;K1)

L1 hücresine yazılıp aşağı doğru çoğaltılacak formül;

=İNDİS(B$1:J$38;K1;EĞERSAY(K$1:K1;K1))

Uitser Madina