Sıralama Bu Kadar mı Zor

[teknoman]

Arkadaşlar excel de soldan sağa ve yukardan aşağı sıralama tamam da,
aynı anda grup içerisinde soldan sağa ve aşağı doğru sıralama yapmanın şekli nedir? Ek teki dosyada takıldım kaldım.Yardımlarınızı bekliyorum

 

[Ömer BARAN]

Merhaba.

Örneğinizde ÜK... şeklindeki kodlarınız 15'ten başlayıp 1'er artarak devam ediyor ama
gerçek belgenizde böyle bir durumun olmadığını varsaydım.

Asıl tablo ile aynı boyutlarda yardımcı tablo oluşturarak yapılmış çözüm ekli belgede.
Yaapılan işlem bir anlamda alfabetik sıralama işlemidir.
.

 

[teknoman]

Ömer hocam çok teşekkür ederim. Peki bu sıralamayı makro ile yapıp tek düğme ile bu düzene getirmemiz mümkün olabilir mi ?

 

[Ömer BARAN]

Tekrar merhaba.

-- Sayfaya bir adet düğme, şekil/metin kutusu gibi bir nesne ekleyin,
-- Alt taraftan ilgili sayfa adına fareyle sağ tıklayıp KOD GÖRÜTÜLEyi seçin,
-- Açılan VBA ekranında sağdaki alana aşağıdaki kod'u yapıştırın,
-- Sayfaya eklediğiniz nesneye fareyle sağ tıklayıp MAKRO ATAyı seçin,
-- Açılan küçük ekranda SIRALAyı seçip işlemi onaylayın.

Artık bu nesneye fareyle tıklayarak sonuç alabilirsiniz.
.

[B]Sub SIRALA()[/B]
[J3:N12].ClearContents: sayı = 1
For sat = 3 To 12
    For sut = 10 To 14
        For satt = 3 To 14
            For sutt = 3 To 7
                If WorksheetFunction.CountIf([C3:G12], "<=" & Cells(satt, sutt)) = sayı Then
                    Cells(sat, sut) = Cells(satt, sutt)
                    sayı = sayı + 1: GoTo 10
                End If
            Next
        Next
10:    Next
Next: MsgBox "İşlem tamamlandı.", vbInformation, "Ömer BARAN"
[B]End Sub[/B]

 

[halit3]

Benzer bir sorunuza aşağıdaki linkde cevap yazmıştım.

http://www.excel.web.tr/f14/kary-yk-sayylary-syralama-t164180.html

kod:

Sub sırala()


Dim x, j, s, i
Set j = CreateObject("Scripting.Dictionary")

Range("J3:N12").ClearContents

Application.ScreenUpdating = False

deger1 = Mid(Cells(3, 3).Value, 1, 2)


UserForm1.ListView1.ListItems.Clear
UserForm1.ListView1.ColumnHeaders.Clear
UserForm1.ListView1.View = lvwReport
UserForm1.ListView1.Gridlines = True
UserForm1.ListView1.FullRowSelect = True
UserForm1.ListView1.ColumnHeaders.Add , , "BENZERSİZLER", 200

For Each x In Range("c3:G12")
If x.Value <> "" Then
'If IsNumeric(x.Value) = True Then
If Not j.exists(x.Value) Then
j.Add x.Value, Nothing
deger2 = Mid(x.Value, 3, Len(x.Value))

UserForm1.ListView1.ListItems.Add , , Format(deger2, "000000000000000")

End If
'End If
End If
Next x

UserForm1.ListView1.Sorted = True
UserForm1.ListView1.SortKey = 0
UserForm1.ListView1.SortOrder = lvwAscending
UserForm1.ListView1.Sorted = False


basla1 = Timer
bekle1 = 1
While Timer < basla1 + bekle1
DoEvents
Wend


Set Sh = Sheets(ActiveSheet.Name)
yer = ActiveSheet.Name
sat1 = 3
n = 9
For r = 1 To UserForm1.ListView1.ListItems.Count
n = n + 1
Sheets(yer).Cells(sat1, n).Value = deger1 & UserForm1.ListView1.ListItems(r).Text * 1
If n = 14 Then n = 9: sat1 = sat1 + 1
Next r


MsgBox "işlem tamam"
Application.ScreenUpdating = True


End Sub

not: dosyanıza bir adet userform ekleyin eklediğiniz userforma da bir adet ListView nesnesi ekleyin

örnek kodda userformun adı (UserForm1) ListView nesnesinin adıda (ListView1 ) olmalı

 

[teknoman]

Ömer hocam çok teşekkür ederim.Sade ve anlaşılır anlatımınızla konuyu çözümledim.
İyi çalışmalar

 

[teknoman]

Halit hocam haklısınız diğer konu gözden kaçmış olmalı.İlginiz için teşekkür ederim

 

[KMLZDMR]

Sayın Ömer Baran Hocam,
Halit3 'ün aşağıdaki linkteki tablonun formül ile yapmınız mümkün müdür. O yöntemi öğrenmek isteriz.

http://www.excel.web.tr/f14/kary-yk-...a-t164180.html