Vehicle routing problem sub in VBA.

routing_sub

Sub run()
Dim iData As Worksheet 'input sheet
Dim mData As Worksheet 'main sheet
Dim bSpeed As Integer 'truck speed variable
Dim bCapacity As Integer 'truck capacity
Dim sNode As Integer 'sum node
Dim nDist() As Double 'node distance
Dim nStat() As String 'node status (pickup or delivery)
Dim nDemand() As Integer 'node demand
Dim nAssign() As Boolean 'node assigned (sebagai variabel untuk mengecek jumlah node yang sudah di-assign)
Dim sAssign As Integer 'sum assigned
Dim sTime As Double 'sum time
Dim nStart As Integer 'node start
Dim nNext As Integer 'node next
Dim nCheck() As Boolean 'node check
Dim minDist As Double 'minimum distance
Dim sLoad As Integer 'sum load
Dim svcTime() As Double 'service time in hour
Dim rute(20) As String 'menyimpan data rute dalam bentuk tulisan. karena tulisannya 20 maka maksimum menampung 20 rute saja. bisa diubah sesuai keinginan
Dim sDist(20), routeTime(20), valLoad(20) As Double 'sum distance dan sum time travel untuk (default) 20 rute (bisa diganti, terserah)
Dim countD As Integer 'count delivery and count pickup

Set iData = Worksheets("Input") 'Memberikan nama iData untuk sheet Input
Set mData = Worksheets("Main") 'Memberikan nama mData untuk sheet Main

'Mengambil parameter
bSpeed = iData.Cells(1, 3)
bCapacity = iData.Cells(1, 8)

'Membaca jumlah node
For i = 1 To 999
    If iData.Cells(4 + i, 1) <> "" Then 'Apabila data di sheet Input kolom A mulai baris 5 tidak kosong, maka...
        sNode = sNode + 1 'Akan dihitung ke variable sNode
    Else
        Exit For 'Jika cell kosong, looping berhenti, jadi tidak looping selama 999 kali
    End If
Next
'---> Output adalah jumlah node, yang secara default = 20

'Mendeklarasi ulang variable array agar jumlahnya sesuai dengan jumlah node
ReDim nDist(sNode, sNode), nStat(sNode), nDemand(sNode), nCheck(sNode)
ReDim nTWS(sNode), nTWE(sNode), nAssign(sNode), svcTime(sNode)

'Membaca parameter node
For a = 1 To sNode
    nDemand(a) = iData.Cells(4 + a, 6) 'Membaca data demand
Next

'Membaca data matriks jarak
For i = 1 To sNode
    For j = 1 To sNode
        nDist(i, j) = iData.Cells(4 + i, 12 + j)
    Next
Next

'Mengidentifikasi depo (node nomer 1) node yang di-assign
nAssign(1) = True 'node nomor 1 sudah di-assign maka bersifat "true"
nCheck(1) = False 'node nomor 1 karena depot maka node check nya false agar selalu diperiksa/tidak di-skip
sAssign = 1 'jumlah yang diassign pertama ada 1 yakni depot itu sendiri
nStart = 1 'node awal mulai dari nomor 1 alias depot
countroute = 1 'Mulai dari rute pertama (1)

Do While sAssign <> sNode 'Selama node yang sudah di-assign dalam rute belum keseluruhan dari node
    '==============================================================================================
    Do Until countD = mData.Cells(4, 3) Or assignD = mData.Cells(4, 3) 'looping hingga semua node Delivery telah dicek semua
    For i = 1 To sNode
        'Mengecek minimum distance untuk delivery
        If i = 1 Then
            minDist = 99999
        ElseIf nCheck(i) = False Then 'nCheck node ke-i apabila false berarti node tersebut sebelumnya belum diperiksa
            If i <> nStart And nDist(nStart, i) < minDist And nAssign(i) = False Then
                minDist = iData.Cells(4 + nStart, 12 + i)
                nNext = i
            End If
        End If
    Next
    
    'Membaca total load
    sLoad = sLoad + nDemand(nNext)
    
    'Mengecek konstrain kapasitas dan time windows
    If nStart = 1 And sLoad <= bCapacity Then 'Apabila node yang di-assign belum ada dan total load masih dibawah kapasitas
        nAssign(nNext) = True 'node ke-nNext di-assign
        sAssign = sAssign + 1 'menambah jumlah node yang diassign
        rute(countroute) = "1 --> " & nNext & " " 'menulis rute dalam string/tulisan
        sDist(countroute) = sDist(countroute) + minDist 'menambah akumulasi jarak
        nStart = nNext 'Node yang terpilih menjadi node start selanjutnya
        minDist = 9999 'Me-reset minimum distance
        lastNd = nNext 'Membaca node terakhir yang di-assign
        countD = countD + 1 'menambah jumlah node delivery yang sudah diperiksa
        assignD = assignD + 1 'menambah jumlah node delivery yang sudah masuk rute
    ElseIf nStart <> 1 And sLoad <= bCapacity Then 'Apabila node yang di-assign lebih dari satu dan total load masih dibawah kapasitas
        nAssign(nNext) = True 'Meng-assign node karena terpilih
        sAssign = sAssign + 1 'Menambah jumlah node yang terpilih
        rute(countroute) = rute(countroute) & "--> " & nNext & " " 'Menulis rute
        sDist(countroute) = sDist(countroute) + minDist 'menambah akumulasi jarak
        nStart = nNext 'Node yang terpilih menjadi node start selanjutnya
        minDist = 9999 'Me-reset minimum distance
        lastNd = nNext 'Membaca node terakhir yang di-assign
        countD = countD + 1 'menambah jumlah node delivery yang sudah diperiksa
        assignD = assignD + 1 'menambah jumlah node delivery yang sudah masuk rute
    ElseIf nStart <> 1 And sLoad > bCapacity Then 'Apabila node yang di-assign melebihi kapasitas
        nCheck(nNext) = True 'Menandakan node "nNext" tidak terpilih karena melebihi kapasitas, agar di-skip untuk mencari min. distance selanjutnya
        sLoad = sLoad - nDemand(nNext) 'Me-reset data jumlah load
        countD = countD + 1 'menambah jumlah node delivery yang sudah diperiksa
    End If
    Loop
    '=============================================================================================
    'Menutup rute dan memulai rute baru
    valLoad(countroute) = sLoad
    rute(countroute) = rute(countroute) & " --> 1" 'tambahan string untuk menutup rute
    sDist(countroute) = sDist(countroute) + nDist(lastNd, 1)
        If sAssign <> sNode Then 'Apabila node yang di-assign belum semuanya maka
            countroute = countroute + 1 'jumlah rute ditambah satu lagi
        End If
    nStart = 1 'me-reset ulang node awal menjadi depot
    countD = 0 'me-reset ulang node delivery agar di-loop selanjutnya, node delivery diperiksa lagi
    sLoad = 0 'me-reset kembali akumulasi load
    For k = 1 To sNode
        nCheck(k) = False 'Me-reset kembali node check karena akan dibuat rute baru
    Next
Loop

'Menuliskan hasil di sheet "Main"
For i = 1 To countroute
    mData.Cells(4 + i, 6) = i 'memberi nomor sebanyak rute yang tercipta (countRoute)
    mData.Cells(4 + i, 7) = rute(i) 'hasil rute dalam string/tulisan
    mData.Cells(4 + i, 8) = sDist(i) 'total jarak tempuh dalam km
    mData.Cells(4 + i, 9) = valLoad(i) 'total load
Next
End Sub