WorksheetFunction.Large ile bulunan değerlerin satırlarını bulmak

[Ergün Güler]

Selam,
Bir makro içinde

WorksheetFunction.Large(s2.Range("C4:C48"), j)

kod ile C4:C48 aralığındaki büyük sayıları buluyorum.
mesela:
C4: 2
C5: 12
C6: 25
C7: 33
C8: 2
C9: 1
C10: 8
C11: 8
C12: 5
C13: 25

sıra ile

33
25
25
12
8
8
5
2
2
1

olarak buluyorum. Sonuçlar doğrudur.
Ancak, aynı zamanda büyük olan sayının satırını bulmak veya karşısıdaki değeri bulmak istiyorum. sıralanan sayılardan aynı olan var ise tüm aynı sayılar için ilk sayının satırını yazıyor.
Örnek 2 değeri için;
Sayı___Satır

2_____4.satır
2_____4.satır olarak buluyor.
Oysa benim isteğim,
Sayı___Satır

2_____4.satır
2_____8.satır olarak bulması.
Yardımcı ollabilirseniz çok sevinirim.
İyi çalışmalar.

 

[Orion1]

Option Base 1
Sub sirala_59()
Dim liste(), i As Byte, j As Byte, x As Variant, deg As String
liste = Range("C4:D13").Value
For i = 1 To UBound(liste, 1) - 1
    For j = i + 1 To UBound(liste, 1)
        If liste(i, 1) > liste(j, 1) Then
            x = liste(i, 1)
            liste(i, 1) = liste(j, 1)
            liste(j, 1) = x
            x = liste(i, 2)
            liste(i, 2) = liste(j, 2)
            liste(j, 2) = x
        End If
    Next j
Next i
For i = 1 To UBound(liste, 1)
    deg = deg & vbLf & liste(i, 1) & "-" & liste(i, 2)
Next i
MsgBox deg & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[Ergün Güler]

Selam Sayın Evren Gizlen,
Çok teşekkür ederim. Ancak Verdiğiniz kodlar ile yapamadım. Aslında ben size sorunu tam anlatamamışım. Örnek dosya ekledim.
İçinde de açıklama vardır.
"Slide-Sıralama" adlı sayfadaki "Sırala" butonuna tıklayınca, Slide sayfasından veriler alınıp, C4:O48 tablosu doluyor. Daha sonra U,X,AA,AD,AG,AJ... sütunları doluyor.

C4:N48 tablosundaki sütunlar Ay'lardır. O4:O48 sütunu ise Yıllıktır.
B satırları ise Slide No.larıdır

Örnek olarak U sütununda 1.aya ait sayılar büyükten küçüğe sıralanıyor.
sol tarafındaki T sütununda ise büyük sayıya ait B sütunundaki değeri vermesini istiyorum. İste bu kısmı yapamadım. Biraz uğraştım. U daki aynı sayılara yine aynı değerleri verdiğinden beceremedim.

Yardımlarınız için şimdiden çok teşekkürler.

 

[Orion1]

Dosyanız ektedir.

Sub SLIDE_SIRALAMA_1()
Dim myarr(), i As Byte, k As Byte, sut As Byte, sat As Byte
sut = 3
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For k = 20 To 53 Step 3
    sat = 4
    For i = 4 To 48
        Cells(i, k).Value = ""
        Cells(i, k + 1).Value = ""
        If Cells(i, sut).Value <> "" And Cells(i, sut) > 0 Then
            Cells(sat, k).Value = Cells(i, "B").Value
            Cells(sat, k + 1).Value = Cells(i, sut).Value
            sat = sat + 1
        End If
    Next i
    Range(Cells(4, k), Cells(48, k + 1)).Sort Cells(4, k + 1), order1:=xlDescending
    sut = sut + 1
Next k
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Sıralanma tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[Ergün Güler]

Selam,
Sayın Gizlen, ilgi ve alakanıza çok teşekkür ederim. Ellerinize sağlık. Harikasınız. Ben de büyük bulmak ile uğraşıyorum. Sort yapmak aklıma hiç gelmememişti.
Bir ek soru sorabilir miyim?
Slide-Sıralamasındaki Slide-Ay tablosunu (soldaki tablo C4:O48 arası) aşağıdaki kodlar ile dolduruyorum. Daha hızlı veya pratik kodlar uygulayabilir miyim? Yardımıcı olabilirseniz çok sevinirim.

Sub SLIDE_SIRALAMA_1() 'sadece Tablo

Dim Satır As Integer, Sütun As Byte
Dim slide, sıra As Worksheet

Set slide = Sheets("Slide")
Set sıra = Sheets("Slide-Sıralama")
son = slide.Range("B65536").End(3).Row
son_ay = Month(slide.Cells(son, "B"))
'sıra.Cells(1, 1) = son_ay

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

sıra.Range("C4:O48").ClearContents
sıra.Range("T4:BE48").ClearContents
artır = 0

For Sütun = 3 To 15

For Satır = 4 To 48

If Sütun < (son_ay + 3) Then

formül1 = Evaluate _
("=SUMPRODUCT((MONTH(Slide!$B$2:$B$130)=" & sıra.Cells(3, Sütun) & ")*(Slide!$C$2:$X$130=" & sıra.Cells(Satır, 2) & "))")

If formül1 <> 0 Then
sıra.Cells(Satır, Sütun) = formül1
End If
End If
If Sütun = 15 Then
formül2 = Evaluate("=SUMPRODUCT((Slide!$C$2:$X$130=" & sıra.Cells(Satır, 2) & ")*1)")
If formül2 <> 0 Then
sıra.Cells(Satır, Sütun) = formül2
End If
End If

Next

Next Sütun

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

MsgBox "Sadece Tablo işlemi Tamamlandı...", vbInformation
    
End Sub