Create a gist now

Instantly share code, notes, and snippets.

What would you like to do?
Vehicle routing problem sub in VBA.
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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment