sütundaki verileri satıra aktarma

[zerali]

arkadaşlar B sütununda bulunan verileri satıra aşağı doğru sıralamak istiyorum bunu formülle yapabilir miyiz 1500 öğrenci var şimdiden teşekkürler

 

[hayri tekin]

Merhaba,
formülle değil ama basit bir alternatif :
sütundaki verilerinizi kopyalayın, özel yapıştır , "işlemi tersine çevir" ' i işaretleyin ve tamam deyin.

not:istediğiniz tam olarak bu değil ama size bir fikir verebilir.

 

[zerali]

tekintek hocam C sütunu ile I sütunu arasına ve alt alta verileri sıralamak istiyorum.

 

[zerali]

Böyle bir formül var mi acaba

 

[acar6783]

Sub ARA()
Application.ScreenUpdating = False


 Set s1 = Sheets("Sheet1")

D = Cells(65536, 1).End(xlUp).Row + 1
For y = 2 To D
If [c1] = Cells(y, 1) Then
c = c + 1
 s1.Cells(c + 1, 3) = Cells(y, 2)
 s1.Cells(c + 1, 4) = Cells(y + 1, 2)
 s1.Cells(c + 1, 5) = Cells(y + 2, 2)
 s1.Cells(c + 1, 6) = Cells(y + 3, 2)
 s1.Cells(c + 1, 7) = Cells(y + 4, 2)
 s1.Cells(c + 1, 8) = Cells(y + 5, 2)
 s1.Cells(c + 1, 9) = Cells(y + 6, 2)
 
End If
Next
End Sub

Modüle kopyalayın ve bir butona atayın işninizi görecektir.

 

[acar6783]

Dosyanız ektedir...

 

[zerali]

acar6783 hocam çok teşekkürler emeğinize sağlık.bu dosya çok işime yarayacak.

 

[acar6783]

Rica ederim
Kolay gelsin...

 

[sakurt]

Üstadım benim zannımca bu dosyay ihtiyacım var ama altın üye değilim bu nedenle indiremiyorum.

Benim sorunum şu: bir satırda 5 sütunluk veriyi her beş sütünda alt satıra yazdırmak istiyorum...

ekte ki dosyada anlatıldığı gibi

 

[Korhan Ayhan]

Siz örnek dosyanızı paylaşım sitelerine yükleyip linkini forumda paylaşabilirsiniz.

 

[sakurt]

Örnek excel dosyası

Dosya ektedir ve gerekli bilgiler yazılı

 

[Ziynettin]

Sub test()
sut = Rows(2).Find("*", , , , xlByColumns, xlPrevious).Column
sat = sut / 5
ReDim b(1 To sat, 1 To 5)
a = Range("A2", Cells(2, sut)).Value
    For j = 1 To UBound(a, 2) Step 5
        say = say + 1
        For y = 1 To 5
            b(say, y) = a(1, j + y - 1)
        Next y
    Next j
Range("A5:E" & Rows.Count) = ""
[A5].Resize(say, 5) = b
MsgBox "İişlem tamam.", vbInformation
End Sub

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Besli_Grupla()
    Dim Veri As Range, Satir As Long, Sutun As Integer
    
    Range("A5:E" & Rows.Count).Clear
    Satir = 5
    Sutun = 0
    
    For Each Veri In Range("A2").Resize(1, Cells(2, Columns.Count).End(1).Column)
        Cells(Satir, 1).Resize(1, 5).Value = Veri.Offset(0, Sutun).Resize(1, 5).Value
        Satir = Satir + 1
        Sutun = Sutun + 4
    Next

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

 

[sakurt]

İlgi ve alakanıza teşekkür ederim.
Allah sizlerden Razı Olsun...!

 

[uygarakgul]

acar6783 Üstadım merhabalar.
ÖRNEK UYGULAMADA YUKARIDAN AŞAĞIYA İNEN SATIR SAYISI SABİT DÖNGÜDE DEVAM EDİYOR, LAKİN SIRALAMA SAYISINDA FARKLILIK OLDUĞUNDA SINIRLAMAYI NASIL YAPACAĞIM ONU ÇÖZEMEDİM.
İLGİNİZE TEŞEKKÜR EDERİM.

 

[Korhan Ayhan]

Büyük harfle yazmanızın özel bir nedeni var mı?

Forum kurallarını okumanızda fayda var.

 

[uygarakgul]

Korhan Ayhan
Bey kusura bakmayın dikkatimden kaçmış. Daha özenli olmaya gayret gösteririm.

 

[Korhan Ayhan]

Nazik üslubunuz ve nezaketiniz için ben teşekkür ederim.

 

[aerten]

İsteğinizi karşılar mı bilmiyorum? Forumdan bazı örnekleri kullanarak bir şeyler yaptım.

 

[YUSUF44]

acar6783 Üstadım merhabalar.
ÖRNEK UYGULAMADA YUKARIDAN AŞAĞIYA İNEN SATIR SAYISI SABİT DÖNGÜDE DEVAM EDİYOR, LAKİN SIRALAMA SAYISINDA FARKLILIK OLDUĞUNDA SINIRLAMAYI NASIL YAPACAĞIM ONU ÇÖZEMEDİM.
İLGİNİZE TEŞEKKÜR EDERİM.

Aşağıdaki makroyu dener misiniz?

Sub yemekler()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "A").End(3).Row
eski = s1.Cells(Rows.Count, "I").End(3).Row
If eski > 1 Then
    s1.Range("I2:XFD" & eski).ClearContents
End If

Set con = VBA.CreateObject("adodb.Connection")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

sorgu = "select distinct [YEMEK ADI] from [Sayfa1$A1:F" & son & "] where [YEMEK ADI] is not null"
Set rs = con.Execute(sorgu)

s1.[I2].CopyFromRecordset rs
yeni = s1.Cells(Rows.Count, "I").End(3).Row
    
For i = 2 To son
    sat = WorksheetFunction.Match(s1.Cells(i, "A"), s1.Range("I1:I" & yeni), 0)
    sut = s1.Cells(sat, Columns.Count).End(xlToLeft).Column + 1
    s1.Cells(sat, sut) = s1.Cells(i, "D")
    s1.Cells(sat, sut + 1) = s1.Cells(i, "E")
    s1.Cells(sat, sut + 2) = s1.Cells(i, "F")
Next
End Sub