Gơi file chuẩn từ đầu để khỏi tốn thời gianCám ơn anh rất nhiều
Anh xem thêm giúp em với
Trên file nguyên gốc của anh khi em thêm xe thì nó vẫn tình được
Nhưng khi em add thêm data trọng tải vào thì file chỉ tính đến xe thứ 3 thôi a
Cần sửa ở đâu để nó có thể tính được hết nhiều xe a, vì mỗi tháng em phải đối chiếu khá nhiều xe
Em cám ơn anh
Mã:
Sub CuocXe()
Dim sArr(), dArr(), cArr(), Res()
Dim stt As Variant, LoaiXe As String, NoiGiao As String
Dim cMax, Cuoc, tmp
Dim i As Long, j As Long, ik As Long, jk As Long, k As Long
With Sheets("Data")
sArr = .Range("A3:O" & .Range("A" & Rows.Count).End(xlUp).Row).Value
cArr = .Range("A2:M2").Value
End With
With Sheets("Sheet1")
dArr = .Range("A2:J" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value
End With
ReDim Res(1 To UBound(dArr), 1 To 3)
With CreateObject("scripting.dictionary")
For j = 5 To 13 'cot trong tai
.Item(cArr(1, j)) = j
Next j
For i = 1 To UBound(sArr)
.Item(sArr(i, 1) & "#" & sArr(i, 2) & "#" & sArr(i, 4)) = i
Next i
For i = 1 To UBound(dArr)
If i = UBound(dArr) Then Exit For
If stt <> dArr(i, 1) Then
stt = dArr(i, 1)
jk = .Item(dArr(i, 10))
LoaiXe = dArr(i, 9)
NoiGiao = dArr(i, 7)
cMax = 0: k = 0: Cuoc = 0
If .Item(dArr(i, 3) & "#" & dArr(i, 7) & "#" & LoaiXe) Then
For j = i To UBound(dArr) - 1
If dArr(j, 1) = stt Then
ik = .Item(dArr(j, 3) & "#" & dArr(j, 7) & "#" & LoaiXe)
If cMax < sArr(ik, jk) Then
cMax = sArr(ik, jk)
tmp = sArr(ik, 14) '14, thu tu cot giao lan 1
End If
If NoiGiao = dArr(j, 7) Then
k = k + 1
If k = 1 Then
Cuoc = Cuoc + sArr(ik, 14)
Else
Cuoc = Cuoc + sArr(ik, 15) '15, thu tu cot giao lan 2
End If
Else
NoiGiao = dArr(j, 7)
k = 0: j = j - 1
End If
Else
Res(i, 1) = cMax
Res(i, 2) = Cuoc - tmp
Res(i, 3) = Res(i, 1) + Res(i, 2)
i = j - 1
Exit For
End If
Next j
End If
End If
Next i
End With
Sheets("Sheet1").Range("K2:M2").Resize(UBound(Res)) = Res
End Sub
