Alt alta olan verileri belirli miktarda yan yana sıralamak

[r-evolve]

Herkese merhaba,

Doktora çalışmamda kullanacağım sıcaklık gözlemlerinin analizini yapmak için bir makroya ihtiyaç duymaktayım.

Analizini yapacağım veriler aynı ayın farklı yıllardaki değerleri. Bu değerleri yan yana getirmem gerekiyor. Kullandığım aydaki gün sayısı 31 gün, bu nedenle her 31 değer sonrası veriyi onun yanına koyabilecek bir makro yazılabilir mi?

Şimdiden teşekkür ederim, iyi forumlar.

1 hosted at ImgBB

Image 1 hosted in ImgBB

ibb.co

2 hosted at ImgBB

Image 2 hosted in ImgBB

ibb.co

 

[Korhan Ayhan]

Görsel yerine 200-300 satırlık küçük bir örnek dosya paylaşırsanız daha kolay çözüme ulaşabilirsiniz.

 

[r-evolve]

Görsel yerine 200-300 satırlık küçük bir örnek dosya paylaşırsanız daha kolay çözüme ulaşabilirsiniz.

Merhaba Korhan Bey,

Ekte gönderiyorum, teşekkür ederim.

base period.xlsx - 29 KB

 

[Korhan Ayhan]

Veriler 4'lü blok halinde mi yan tarafa aktarılacak?

 

[r-evolve]

Her bir ay (31 değer) yan yana getirilecek

 

[Korhan Ayhan]

Yani A32:D62 arasını kesip E1 hücresine yapıştıracak. Bu şekilde devam edecek doğru mudur?

 

[dost]

Merhaba,

Sub TransposeVeri()

Dim sonsat, i, nRow As Integer

sonsat = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To sonsat Step 31

    nRow = nRow + 1
    Range("F" & nRow) = Range("A" & i)
    Range("D" & i & ":D" & i + 30).Copy
    Cells(nRow, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True

Next i

End Sub

 

[r-evolve]

Yani A32:D62 arasını kesip E1 hücresine yapıştıracak. Bu şekilde devam edecek doğru mudur?

Eğer yer olarak fark etmiyorsa, evet dediğiniz şekilde.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Yana_Aktar()
    Dim X As Long, Sutun As Integer
    
    Range("E:XFD").Clear
    
    Sutun = 5
    
    For X = 32 To Cells(Rows.Count, 1).End(3).Row Step 31
        Range("A" & X).Resize(31, 4).Cut Cells(1, Sutun)
        Sutun = Sutun + 4
    Next

    Columns.AutoFit

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[r-evolve]

Deneyiniz.

Option Explicit

Sub Yana_Aktar()
    Dim X As Long, Sutun As Integer
   
    Range("E:XFD").Clear
   
    Sutun = 5
   
    For X = 32 To Cells(Rows.Count, 1).End(3).Row Step 31
        Range("A" & X).Resize(31, 4).Cut Cells(1, Sutun)
        Sutun = Sutun + 4
    Next

    Columns.AutoFit

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Teşekkür ederim ama tarihleri de aralarına koymadan sadece D sütununda bulunan değerleri yan yana koyabilir miyiz? Eğer olmuyorsa da bu şekilde kullanıp tarihleri elle silebilirim.

 

[r-evolve]

Merhaba,

Sub TransposeVeri()

Dim sonsat, i, nRow As Integer

sonsat = Cells(Rows.Count, "A").End(xlUp).Row

For i = 1 To sonsat Step 31

    nRow = nRow + 1
    Range("F" & nRow) = Range("A" & i)
    Range("D" & i & ":D" & i + 30).Copy
    Cells(nRow, "G").PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True

Next i

End Sub

Maalesef, değerleri yan yana değil alt alta koydu. Yine de çok teşekkür ederim.

 

[Korhan Ayhan]

#8 nolu mesajınızı okuyunuz lütfen...

Verdiğim kod sizin verdiğiniz cevaptaki işlemi yapıyor.

 

[r-evolve]

#8 nolu mesajınızı okuyunuz lütfen...

Verdiğim kod sizin verdiğiniz cevaptaki işlemi yapıyor.

Yer olarak fark etmiyor diye düşünüp cevaplamıştım. Yine de işime yarayacak.

Çok teşekkür ederim, kolay gelsin.

İyi ki varsınız. İyi forumlar dilerim

 

[Korhan Ayhan]

Veriler sizin istediğiniz şekilde de aktarılır. Fakat #4 nolu mesajımda size bir soru yöneltmiştim.

Siz cevap verdiniz. Ben bu cevaptan yeterli bilgiyi alamayınca hücre adresi vererek örneklendirdim. Sonrasında sizin cevabınıza göre kodu hazırladım.

Şimdi son talebinize göre sadece D sütunundaki veriler yan yana aktarılınca A-B-C sütununda atıl veriler kalacaktır. Bunlar ne olacak? Silinecek mi?

 

[Korhan Ayhan]

Bu kod da son mesajımda bahsettiğim işlemleri yapıyor. İsterseniz kullanabilirsiniz.

Option Explicit

Sub Yana_Aktar()
    Dim X As Long, Sutun As Integer
    
    Range("E:XFD").Clear
    
    Sutun = 5
    
    For X = 32 To Cells(Rows.Count, 1).End(3).Row Step 31
        Range("D" & X).Resize(31).Cut Cells(1, Sutun)
        Sutun = Cells(1, Columns.Count).End(1).Column + 1
    Next

    Range("A32:C" & Rows.Count).Clear

    Columns.AutoFit

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub