• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Büyükten küçüğe sıralama!

Katılım
2 Eylül 2008
Mesajlar
12
Excel Vers. ve Dili
Excel 2003
Arkadaşlar ekteki örnek dosyada belirttiğim şekilde hata bildirim formu hazırlamak istiyorum. Hata yapan firma,bölüm ve kişilerin en fazladan en aza doğru sıralamasını yapan bi formül hazırlayabilirmisiniz?
 

Ekli dosyalar

Son düzenleme:
Dosyanız ektedir.:cool:
Kod:
Sub encok_hata()
Dim liste(), x As Variant, k As Byte, i As Byte, j As Byte
Range("E27:G31").ClearContents
ReDim liste(1 To 5, 1 To 2)
liste = Range("A3:B7").Value
For i = 1 To UBound(liste, 1) - 1
    For j = i + 1 To UBound(liste, 1)
        If liste(i, 2) < liste(j, 2) Then
            For k = 1 To 2
                x = liste(i, k)
                liste(i, k) = liste(j, k)
                liste(j, k) = x
            Next
        End If
    Next
Next
k = 0
For i = 27 To 31
    k = k + 1
    Cells(i, "E").Value = liste(k, 1)
Next
For i = 1 To 5
    liste(i, 1) = Cells(10, i).Value
    liste(i, 2) = Cells(16, i).Value
Next i
For i = 1 To UBound(liste, 1) - 1
    For j = i + 1 To UBound(liste, 1)
        If liste(i, 2) < liste(j, 2) Then
            For k = 1 To 2
                x = liste(i, k)
                liste(i, k) = liste(j, k)
                liste(j, k) = x
            Next
        End If
    Next
Next
k = 0
For i = 27 To 31
    k = k + 1
    Cells(i, "F").Value = liste(k, 1)
Next
For i = 1 To 5
    liste(i, 1) = Cells(10, i + 6).Value
    liste(i, 2) = Cells(16, i + 6).Value
Next i
For i = 1 To UBound(liste, 1) - 1
    For j = i + 1 To UBound(liste, 1)
        If liste(i, 2) < liste(j, 2) Then
            For k = 1 To 2
                x = liste(i, k)
                liste(i, k) = liste(j, k)
                liste(j, k) = x
            Next
        End If
    Next
Next
k = 0
For i = 27 To 31
    k = k + 1
    Cells(i, "G").Value = liste(k, 1)
Next
End Sub
 

Ekli dosyalar

Geri
Üst