Matris Tablodan Listeye Sıralatma

[baydeniro]

Merhaba arkadaşlar. Veri aralığındaki matris tabloda en yüksek rakamın kesişme noktasından başlayarak büyükten küçüğe sıralama yapmak mümkün mü ? Formül ve/veya makro olabilir. Örnek dosya ektedir.

 

[Merhum İdris SERDAR]

Merhaba arkadaşlar. Veri aralığındaki matris tabloda en yüksek rakamın kesişme noktasından başlayarak büyükten küçüğe sıralama yapmak mümkün mü ? Formül ve/veya makro olabilir. Örnek dosya ektedir.

.

Dosyanız ekte.

.

 

[apocalyt]

yurttaş hocam cevaplamış ...bende makro bişiler yapmaya çalıştım..boşa gitmesin

Sub daylight()
Application.ScreenUpdating = False
Range("d2:j6").Copy
Range("aa2").PasteSpecial (xlPasteValues)
For x = 1 To 35
a = WorksheetFunction.Large(Range("d2:j6"), 1)
b = Range("d2:j6").Find(a).Address
Cells(8 + ben, "d") = a
Cells(8 + ben, "c") = Range(Mid(b, 2, 1) & 1)
Cells(8 + ben, "b") = Range("c" & Mid(b, 4, 1))
ben = ben + 1
Range(b).ClearContents
Next x
Range("aa2:ag6").Copy Destination:=Range("d2")
Range("aa2:ag6").ClearContents
Application.ScreenUpdating = True
End Sub

 

[baydeniro]

Sayın Yurttas, sayın apocalyt çok çok teşekkür ederim. Şimdi hem formül hem de makro müthiş iki çözüm oldu. Elleriniz dert görmesin, sağlıcakla kalın.

 

[suleyman242]

Merhaba arkadaşlar. Veri aralığındaki matris tabloda en yüksek rakamın kesişme noktasından başlayarak büyükten küçüğe sıralama yapmak mümkün mü ? Formül ve/veya makro olabilir. Örnek dosya ektedir.

bende bişeyler yapmıştım
boşa gitmesin

Private Sub CommandButton1_Click()
    Sheets("SONUC").Select
    Range("A1:C35").Select
    Selection.ClearContents
Set lst = Worksheets("LISTE")
Set snc = Worksheets("SONUC")
xy = 1
For x = 4 To 10
For y = 2 To 6
snc.Cells(xy, "C") = lst.Cells(y, x).Value
xy = xy + 1
Next y
Next x
            Sheets("SONUC").Select
    Range("C1:C35").Select
    ActiveWorkbook.Worksheets("SONUC").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("SONUC").Sort.SortFields.Add Key:=Range("C1:C35"), _
        SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("SONUC").Sort
        .SetRange Range("C1:C35")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
xy = 1
For abc = 1 To 35
For x = 4 To 10
For y = 2 To 6
If snc.Cells(xy, "C").Value = lst.Cells(y, x).Value Then
snc.Cells(xy, "A") = lst.Cells(1, x)
snc.Cells(xy, "B") = lst.Cells(y, 3)
' MsgBox "x= " & x & "  y= " & y
xy = xy + 1
GoTo 50
Else
End If
Next y
Next x
50
Next abc
Unload Me
End Sub

 

[baydeniro]

Sayın Suleyman242 çok teşekkür ederim. Bu çözüm "BOŞA GİTMESİN" in ötesinde kaliteli bir çalışma, emeğinize sağlık, çok iyi bir çözüm. Minik bir revizyon yapılabilir mi : Örneğin 40 tan büyük olanları listele gibi bir işlev eklenebilir mi ?

 

[suleyman242]

Minik bir revizyon yapılabilir mi : Örneğin 40 tan büyük olanları listele gibi bir işlev eklenebilir mi ?

Tamam; istediğin değeri sen verebilirsin.
Dosyayıdüzenleyip ekledim.