Nhờ giúp file tính cước vận chuyển

[HieuCD]

Cá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

Gơi file chuẩn từ đầu để khỏi tốn thời gian

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

Sheet data thiếu dữ liệu

 

[Crystal199]

Gơi file chuẩn từ đầu để khỏi tốn thời gian

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

Sheet data thiếu dữ liệu

Dạ em xin lỗi a, em sẽ rút kinh nghiệm a
Em cám ơn anh rất nhiều

Bài đã được tự động gộp: 16/8/18

Tôi gửi cách bằng công thức theo đúng file bạn gửi mẫu bài #17.

Nếu file thật của bạn mà thay đổi Vùng "TP.HCM - Đà Nẵng" thành "Hà Nội ..." gì gì đó, hoặc thay đổi các yếu tố khác thì công thức sẽ không phù hợp. Tốt nhất là bạn đưa dữ liệu có cấu trúc file thật, nhưng có thể lược bớt dòng, nhưng những điều kiện về địa phương (nơi đi, nơi đến) hoặc tải trọng xe, hay điều kiện gì gì nữa phải là thật, để anh em nhắm tình hình viết code hay công thức cho phù hợp.

Chứ lâu lâu bạn nảy ra cái yêu cầu này, rồi lại thêm thắt cái yêu cầu khác phải làm lại, thì anh em xem đó là việc "dắt mũi" và không nên nha bạn!

Xem file kèm.
Thân

Dạ em xin lỗi a, em sẽ rút kinh nghiệm a
Em cám ơn anh rất nhiều