isal

 Macro

Kelompok Excel

Fauzia Rahma

Faizal Ali Rozan

Iqbal Baihaqi

Buat tampilan muka seperti di bawah ini :

Tambah tombol button di insert di tab Develover bisa juga kok Shape

Setelah itu masuk ke menu bar > Developer lalu pilih View code atau bisa pilih visual basic paling kiri

Setelah itu akan muncul tampilan seperti ini :

Lalu masukan program seperti dibawah ini :

Dan ini Codingannya

Public Sub Shuffle()

    Dim lCnt As Long

    Dim rRng As Range

    Set rRng = Sheet1.Range("B6:F13")

    Do

        'Add a random value for sorting

        With rRng.Columns(4)

            .Formula = "=RAND()"

            .Value = .Value

        End With

        'Sort on random value

        Sheet1.Sort.SortFields.Clear

        Sheet1.Sort.SortFields.Add rRng.Columns(4), xlSortOnValues, xlAscending

        With Sheet1.Sort

            .SetRange rRng.Offset(-1).Resize(rRng.Rows.Count + 1)

            .Header = xlYes

            .MatchCase = False

            .Orientation = xlTopToBottom

            .Apply

        End With

        lCnt = lCnt + 1

    'if any rows are the same as the starting row

    'do it again

    Loop Until ShuffleComplete(rRng.Columns(5)) Or lCnt > 100

    Debug.Print lCnt

End Sub

Public Function ShuffleComplete(rRng As Range) As Boolean

    Dim rCell As Range

    Dim bReturn As Boolean

    bReturn = True

    For Each rCell In rRng.Cells

        If rCell.Value = rCell.Row Then

            bReturn = False

            Exit For

        End If

    Next rCell

    ShuffleComplete = bReturn

End Function

Lalu klik kanan pada button acak > pilih Assign macro

Lalu akan muncul tampilan seperti dibawah ini dan pilih Sheet1.Shuffle > lalu pilih OK

Selanjutnya klik button acak untuk melihat outputnya