Viết code đếm dữ liệu với 2 điều kiện TÊN& QUÃNG ĐƯỜNG

[vubichngoan]

Cảm ơm mọi người nhiều vì đã ghé qua topic này và xin giúp đỡ mình một vấn đề như sau nhé!
Mình có 1 bản danh sách như file đính kèm
- Giờ mình muốn đếm số lần vận chuyển hàng của các lái xe đã đi dựa trên căn cứ là:quãng đường vận chuyển & tên của lái xe
như cột SC mình vẫn đếm và đánh thủ công rất là vất vả
- Mình rất mong được sự giúp đỡ và cảm ơn mọi người. Chúc mọi người sức khỏe và niềm vui

 

[leonguyenz]

Bạn nên chỉ rõ cách tính số chuyến: tính theo ngày, theo số xe hay theo tên tài xế? Bạn có thể cắt bớt dòng cho file nhẹ hơn và ví dụ cách tính.

 

[sealand]

Mình tham gia dùng Pivot Table có lẽ nhanh gọn. Bạn tham khảo kha

 

[concogia]

Cảm ơm mọi người nhiều vì đã ghé qua topic này và xin giúp đỡ mình một vấn đề như sau nhé!
Mình có 1 bản danh sách như file đính kèm
- Giờ mình muốn đếm số lần vận chuyển hàng của các lái xe đã đi dựa trên căn cứ là:quãng đường vận chuyển & tên của lái xe
như cột SC mình vẫn đếm và đánh thủ công rất là vất vả
- Mình rất mong được sự giúp đỡ và cảm ơn mọi người. Chúc mọi người sức khỏe và niềm vui

Bạn thử code này xem

Private Sub Worksheet_Activate()
Dim Vung, I, d, Mg(), K, kK
    Set d = CreateObject("scripting.dictionary")
    Vung = Sheets("sheet1").Range(Sheets("sheet1").[E4], Sheets("sheet1").[E10000].End(xlUp)).Resize(, 2).Value
    ReDim Mg(1 To UBound(Vung), 1 To 2)
        For I = 1 To UBound(Vung)
            If Vung(I, 2) <> "" Then
                If Not d.exists(Vung(I, 1)) Then
                    K = K + 1
                    d.Add Vung(I, 1), K
                    Mg(K, 1) = Vung(I, 1): Mg(K, 2) = 1
                Else
                    kK = d.Item(Vung(I, 1))
                    Mg(kK, 2) = Mg(kK, 2) + 1
                End If
            End If
        Next I
    [a3:a1000].ClearContents
    [A3].Resize(UBound(Mg), 2) = Mg
End Sub

Tên Tài hoặc quãng đường không có thì để trống không cần ghi số không (0) vào
Bạn thử chỉnh sửa , thêm, bớt dữ liệu ở sheet1, chọn sheet "KetQua" xem kết quả
Thân

 

[sealand]

Hì, khá lâu rồi không được đàm đạo với Bác Cò, hôm nay chọc Bác cái chơi nhỉ!!!
Code của Bác Cò, Sealand xin được tham gia như sau:
-Không phải là đếm tất cả cung đường mà phải đếm mỗi lái xe chạy những cung đường nào, bao nhiêu chuyến để thanh toán Xăng dầu chẳng hạn.
-Sealand xin có 1 mẹo nhỏ mà ít thấy mọi người dùng. Ta lợi dụng cai Item được chỉ định bằng Key có thể thay đổi được nên ta mượn luôn nó làm nơi chứa kết quả. Code rất gọn gàng và bỏ đi rất nhiều biến của Bác. (Lưu ý: Cái Item này chế biến 1 chút là chứa luôn cả mảng dữ liệu ngon lành)

Bác xem Sealand sửa code của Bác có đưqợc không?

Private Sub Worksheet_Activate()
Dim Vung, I, d
 Set d = CreateObject("scripting.dictionary")
  Vung = Sheets("sheet1").Range(Sheets("sheet1").[E4], _
   Sheets("sheet1").[E10000].End(xlUp)).Resize(, 2).Value
     For I = 1 To UBound(Vung)
      If Vung(I, 2) <> "" Then
       If Not d.exists(Vung(I, 1) & " - " & Vung(I, 2)) Then
         d.Add Vung(I, 1) & " - " & Vung(I, 2), 1
          Else
         d.Item(Vung(I, 1) & " - " & Vung(I, 2)) _
         = d.Item(Vung(I, 1) & " - " & Vung(I, 2)) + 1
        End If
       End If
      Next I
    [a3:b1000].ClearContents
   [A3].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)
  [b3].Resize(d.Count) = WorksheetFunction.Transpose(d.Items)
[a3:b3].Resize(d.Count).Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
End Sub

 

[Lê Duy Thương]

hì, khá lâu rồi không được đàm đạo với bác cò, hôm nay chọc bác cái chơi nhỉ!!!
Code của bác cò, sealand xin được tham gia như sau:
-không phải là đếm tất cả cung đường mà phải đếm mỗi lái xe chạy những cung đường nào, bao nhiêu chuyến để thanh toán xăng dầu chẳng hạn.
-sealand xin có 1 mẹo nhỏ mà ít thấy mọi người dùng. Ta lợi dụng cai item được chỉ định bằng key có thể thay đổi được nên ta mượn luôn nó làm nơi chứa kết quả. Code rất gọn gàng và bỏ đi rất nhiều biến của bác. (lưu ý: Cái item này chế biến 1 chút là chứa luôn cả mảng dữ liệu ngon lành)

bác xem sealand sửa code của bác có đưqợc không?

private sub worksheet_activate()
dim vung, i, d
 set d = createobject("scripting.dictionary")
  vung = sheets("sheet1").range(sheets("sheet1").[e4], _
   sheets("sheet1").[e10000].end(xlup)).resize(, 2).value
     for i = 1 to ubound(vung)
      if vung(i, 2) <> "" then
       if not d.exists(vung(i, 1) & " - " & vung(i, 2)) then
         d.add vung(i, 1) & " - " & vung(i, 2), 1
          else
         d.item(vung(i, 1) & " - " & vung(i, 2)) _
         = d.item(vung(i, 1) & " - " & vung(i, 2)) + 1
        end if
       end if
      next i
    [a3:b1000].clearcontents
   [a3].resize(d.count) = worksheetfunction.transpose(d.keys)
  [b3].resize(d.count) = worksheetfunction.transpose(d.items)
[a3:b3].resize(d.count).sort key1:=range("a3"), order1:=xlascending, header:=xlguess
end sub

theo em loại này dùng pivot là dễ quản lý mà chính xác nhất bác sealand ạ
khong biết em làm trong file có đúng ý tác giả không ? .