VBA untuk peringkat

  1. 3 tahun lalu
    Di sunting 3 tahun lalu oleh antoniotanjung

    Selamat pagi semuanya.
    Mau nanya tentang VBA, untuk rumus peringkat di vba di bawah ini kenapa tidak berfungsi ya. Mohon bantuanya, terima kasih

  2. Caton

    26 Mar 2021 Terverifikasi Indonesia + 20.101 Poin

    Pak @antoniotanjung ...

    Kalau boleh tau, masalahnya dimana ya pak? Saya jalankan scriptnya normal saja, dan kolom peringkat terisi.

  3. Mas @Caton
    Pada kolom rata-rata atau sel v62 kebawah masih tidak sesuai, lalu untuk peringkat kenapa 1 semua?

  4. Caton

    26 Mar 2021 Terverifikasi Indonesia + 20.101 Poin

    Pak @antoniotanjung ...

    Kalau saya jalankan scriptnya, hasilnya begini :

    Untitled.png

    Tapi coba bapak tambahkan baris berikut :

    With Application
    .DisplayAlerts = True
    .EnableEvents = True
    .ScreenUpdating = True
    End With

    di baris terakhir sebelum keluar dari prosedur tersebut.

    Demikian.

  5. Mas @Caton
    Kok disaya masih salah ya? dan untuk rata-ratanya kenapa hasilnya salah ya mas?seharusnya 12 + 17 = 29 lalu bagi 2 hasilnya14,5 dan untuk peringkatnya juga hasilnya 1 semua

  6. Caton

    26 Mar 2021 Terverifikasi Indonesia + 20.101 Poin

    Pak @antoniotanjung ...

    Saat ini, saya juga tidak tahu mengapa demikian. Namun, mungkin bisa dicoba mengubah baris :

    ...
    Range("W" & k).Value = Application.WorksheetFunction.Rank(Range("V" & k), Range("V62:V97"),0)
    ...

    menjadi seperti ini (buang argumen Order-nya) :

    ...
    Range("W" & k).Value = Application.WorksheetFunction.Rank(Range("V" & k), Range("V62:V97"))
    ...

    Demikian.

  7. mas @Caton , terima kasih mas. Sudah dicoba tapi tetap tidak berubah.
    Kalau untuk kolom V, rumusnya sudah betul atau salah mas?

  8. Caton

    26 Mar 2021 Terverifikasi Indonesia + 20.101 Poin

    Pak @antoniotanjung ...

    Kalau memang tidak berubah, coba gunakan fungsi Rank_Eq atau Rank_Avg dari WorksheetFunction tersebut. Jika tidak ada perubahan, coba gunakan formula biasa pada kolom yang bermasalah tersebut untuk memastikan apakah kesalahan memang pada fungsi dari WorksheetFunction tersebut atau disebabkan hal lainnya.

    Demikian.

  9. Caton

    27 Mar 2021 Terverifikasi Indonesia + 20.101 Poin

    Pak @antoniotanjung ...

    Coba hapus dahulu perintah :

    On Error Resume Next

    untuk mengetahui apakah ada kesalahan pada script. Dan perbaiki juga pengulangan berikut :

    ...
    For p = 15 To 50
        ...
    Next p
        
    For k = 62 To 97
        ...
    Next k
    ...

    menjadi :

    ...
    For p = 15 To 49
        ...
    Next p
        
    For k = 62 To 96
        ...
    Next k
    ...

    Demikian.

  10. @Caton , sudah bisa mas untuk peringkat, tapi harus klik 2x tombolnya baru muncul peringkat yang bener.
    Mas, mau tanya lagi, kalau untuk mencari rata-rata beda sel, koding nya apa?
    kasus terlampir

  11. Caton

    29 Mar 2021 Terverifikasi Indonesia + 20.101 Poin

    Pak @antoniotanjung ...

    Sedikit bahasan tentang awal masalah. Setelah saya pelajari kembali, masalah rangking yang terjadi pada pertanyaan awal :

    -image-

    sebenarnya terjadi dikarenakan kesalahan meletakkan perintah kalkulasi. Dalam hal ini, saya tidak teliti melihat alur prosesnya. Coba kita lihat dahulu script awalnya :

    For k = 62 To 97
        Range("T" & k).Value = Application.WorksheetFunction.Sum(Range("E" & k, "S" & k))
        Range("U" & k).Value = Application.WorksheetFunction.Average(Range("E" & k, "S" & k))
        Range("V" & k).Value = Application.WorksheetFunction.Sum(Range("U" & p) & Range("U" & k))
        Range("W" & k).Value = Application.WorksheetFunction.Rank(Range("V" & k), Range("V62:V97"))
    Next k

    Pada pengulangan di atas, seharusnya perintah pengisian Rangking dilakukan setelah range acuan selesai diisi. Jadi, untuk perintah :

    Range("W" & k).Value = Application.WorksheetFunction.Rank(Range("V" & k), Range("V62:V97"))        

    seharusnya dilakukan terpisah, yakni setelah proses pengisian data di kolom V selesai dilakukan. Itu penyebab mengapa hasil kalkulasi Rangking tidak tampil dengan benar.

    Kemudian, untuk pertanyaan bagaimana mencari nilai rata-rata beda sel, kalau maksudnya adalah bagaimana mendapatkan nilai pada kolom V di tabel kedua, maka sesuai rumusannya yakni :

    Rata-Rata = Rata-Rata Nilai Pengetahuan dan Rata-Rata Nilai Ketrampilan

    Jadi dalam hal ini, nilai rujukan yang akan diambil adalah nilai pada kolom U pada masing-masing tabel sesuai nama (baris) terkait. Oleh karena data pada kolom B sampai dengan kolom D pada kedua tabel tersebut tersusun dalam urutan yang sama, maka kita cukup mengambil data pada masing-masing baris dari setiap tabel. Untuk baris ke-1 pada tabel kedua, aktualnya di baris ke-62. Dan untuk baris ke-1 pada tabel pertama, aktualnya ada pada baris ke-15. Jadi ada jarak 47 baris antar kedua baris data.

    Karena pada proses pengulangan digunakan variabel yang merujuk kepada baris aktual pada tabel kedua, maka kita cukup mengurangi variabel tersebut dengan nilai 47 untuk merujuk kepada baris aktual pada tabel pertama. Ilustrasinya :

    For lBaris = 62 To 96
        Cells(lBaris, "V") = Application.Average(Cells(lBaris, "U"), Cells(lBaris - 47, "U"))
    Next

    Selengkapnya, lebih kurang seperti berikut :

    Sub HitungNilai()
        Dim xlWS As Worksheet
        Dim lR As Long
        
        Set xlWS = Sheet1
        With Application
            .ScreenUpdating = False
            
            For lR = 15 To 49
                xlWS.Range("T" & lR) = .Sum(xlWS.Range("E" & lR & ":S" & lR))
                xlWS.Range("U" & lR) = .Average(xlWS.Range("E" & lR & ":S" & lR))
            Next
            
            For lR = 62 To 96
                xlWS.Range("T" & lR) = .Sum(xlWS.Range("E" & lR & ":S" & lR))
                xlWS.Range("U" & lR) = .Average(xlWS.Range("E" & lR & ":S" & lR))
                xlWS.Range("V" & lR) = .Average(xlWS.Range("U" & lR), xlWS.Range("U" & lR - 47))
            Next
        
            For lR = 62 To 96
                xlWS.Range("W" & lR) = .Rank_Avg(xlWS.Range("V" & lR), xlWS.Range("V62:V96"))
            Next
            
            .ScreenUpdating = True
        End With
    End Sub

    Demikian, semoga sesuai.

  12. Sukses mas @Caton , terima kasih banyak

 

atau Mendaftar untuk ikut berdiskusi!