sıralama

[atak05]

c kolonundan ALİ leri bulup sırasıyla g kolonuna tarihi ve h kolonuna ali yazacak ve sıralayacak.

c kolunundan VELİ yi bulup sırayla l kolonuna tarihi ve L kolonunana veli yazacak sıralayacak.


yardımcı olursanız sevinirim. Teşekkürler.

 

[suleyman242]

c kolonundan ALİ leri bulup sırasıyla g kolonuna tarihi ve h kolonuna ali yazacak ve sıralayacak.

c kolunundan VELİ yi bulup sırayla l kolonuna tarihi ve L kolonunana veli yazacak sıralayacak.


yardımcı olursanız sevinirim. Teşekkürler.

dosyayı ekledim

 

[YUSUF44]

Süleyman Bey'e ilave olarak eğer hazırladığı kodları aşağıdakiyle değiştirirseniz verileri sıraladıktan sonra etrafına kenarlık çizip sütun genişliklerini ayarlar:

Private Sub CommandButton1_Click()
Columns("F:" & Split(Columns([cz4].End(xlToLeft).Column).Address, ":$")(1)).Delete
'Range("F1:AA500").Borders.LineStyle = 0
sat = 4
For r = 4 To [C65536].End(3).Row
If WorksheetFunction.CountIf(Range("c4:c" & r), Cells(r, "c")) = 1 Then
Sheets("Sayfa1").Cells(sat, "D").Value = Sheets("Sayfa1").Cells(r, "C").Value
sat = sat + 1
End If
Next r
SUT = 7
For i = 4 To [D65536].End(3).Row
say = 1
sat = 4
ara = Cells(i, "D").Value

With Worksheets(1).Range("C4:c500")
    Set c = .Find(ara, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            Set c = .FindNext(c)
            Cells(sat, SUT).Value = Cells(c.Row, "B").Value
            Cells(sat, SUT + 1).Value = ara
            Cells(sat, SUT - 1).Value = say
            sat = sat + 1: say = say + 1
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
    For m = 4 To sat - 1
    For j = m + 1 To sat - 1            ' dolu hücre sayısı
        If Cells(j, SUT).Value < Cells(m, SUT).Value Then   ' eğer bir sonraki hücrenin değeri büyükse
            deger = Cells(m, SUT).Value                     ' seçili hücreyi hafızaya al
            Cells(m, SUT).Value = Cells(j, SUT).Value       ' küçük olan değeri seçili olan satıra yaz
            Cells(j, SUT).Value = deger                     ' hafızaya alınan sayıyıda sonraki yere yaz
            deger = ""                                      ' hafızayı boşalt
        End If
        Next
    Next
SUT = SUT + 4
Next
For k = 6 To [cz4].End(xlToLeft).Column Step 4
Range(Cells(4, k), Cells(4, k).End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.LineStyle = 1
    Next
    [cz4].End(xlToLeft).Select
    [a1] = Selection.Column
    [b1] = Split(Columns([cz4].End(xlToLeft).Column).Address, ":$")(1)
 Columns("F:" & Split(Columns([cz4].End(xlToLeft).Column).Address, ":$")(1)).Select
Selection.EntireColumn.AutoFit
[a1].Select
MsgBox "İşlem Tamam ! "
End Sub

 

[suleyman242]

For k = 6 To [cz4].End(xlToLeft).Column Step 4
[COLOR="Red"]Range(Cells(4, k), Cells(4, k).End(xlToRight)).Select[/COLOR]
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Borders.LineStyle = 1
    Next
    [cz4].End(xlToLeft).Select
    [a1] = Selection.Column
    [b1] = Split(Columns([cz4].End(xlToLeft).Column).Address, ":$")(1)
 Columns("F:" & Split(Columns([cz4].End(xlToLeft).Column).Address, ":$")(1)).Select
Selection.EntireColumn.AutoFit

Yusuf hocam çok teşekkürler sizin sayenizde bu kod yardımı ile değişken veri sıralamayıda yaptım sizlere çok teşekkürler

b = Sheets("sayfa1").Cells(65536, sut).End(xlUp).Row
[COLOR="Red"]Sheets("sayfa1").Range(Cells(4, sut), Cells(b, sut))[/COLOR].Sort _
Key1:=Sheets("sayfa1").Cells(4, sut), Order1:=xlAscending

 

[atak05]

süleyman bey ve yusuf bey çok teşekkür ederim bu kodla değilde formülle yapılabilirmi.

 

[YUSUF44]

Bir şey değil Süleyman Bey. Ben sizin yaptıklarınızı yani süzerek aktarmayı yapamazdım, hatta uğraştım, kodları her isim için ayrı ayrı düzenleyebildim ama farklı isimler olunca nasıl yapacağımı bilemediğimden uğraşmayı bırakmıştım. Sizin kodları görünce ben de tamamlamak için uğraştım. Ben size teşekkür ediyorum.

Bu arada kodların son bölümünde yer alan aşağıdaki satırlar benim son sütunu bulabilmek için yaptığım denemelerden kalma olup, kodların çalışması için bir etkisi yoktur. İsterseniz çıkarabilirsiniz:

   [cz4].End(xlToLeft).Select
    [a1] = Selection.Column
    [b1] = Split(Columns([cz4].End(xlToLeft).Column).Address, ":$")(1)