Lọc dữ liệu theo nhóm bằng VBA

[hoamattroicoi]

Em có một vấn để nhờ các sư phụ, các anh...giúp đỡ.
- Trên sheet Nhap du lieu em có 2 cột Số xe và Số lệnh
- Với mỗi số xe có rất nhiều số lệnh đi kèm.
- Trên sheet Tham chieu em liệt liệt kê ra tất cả số xe xuất hiện

- Làm thế nào em có thể lọc được tất cả các số lệnh đi theo số xe BẰNG VBA

Đây chỉ là dữ liệu mẫu, dữ liệu thực tế khoảng 1000 dòng nên em không thể dùng công thức để trích lọc được vì ảnh hưởng đến tốc độ bảng tính.
Mong nhận được sự giúp đỡ từ gia đình GPE
Em xin chân thành cảm ơn!

 

[ptm0412]

Hướng viết VBA là như vầy:
Sủ dụng 1 mảng SourceArr và 1 mảng ResultArr. Mảng RArr nhiều hơn kết quả cần dùng 1 cột. Cột này để đếm số lần xuất hiện của lệnh cho mỗi xe. Trong bài có 13 cột thì RArr có 14 cột.
Tạo 1 Scripting Dictionary Dic
Khai báo biến đếm số xe s

Dùng For i Duyệt qua cột 1 của mảng SArr

1. Nếu trong Dic chưa có số xe, thì tăng biến đếm xe s lên 1, Add số xe vào item của Dic, và add biến đếm s vào key
Đồng thời gán SArr(i, 1) vào RArr(s, 1) và Sarr(i, 2) vào RArr(s, 3)
Ngoài ra, gán RArr(s, 14) = 1

2. Nếu đã có số xe trong Dic:
- Dò item số xe đã có của Dic, lấy key, giả sử n
- Dùng key tra dòng n mảng RArr, tăng giá trị ở cột 14 lên 1: Rarr(n,14) = Rarr(n,14) +1
- Gán SArr(i, 2) vào RArr(n, Rarr(n,14) + 2)

Cuối cùng gán Mảng RArr xuống sheet. Nếu khéo gán, thì không bị gán cột 14 xuống.

Kết quả: cột B (tuyến) trống trơn. Dùng công thức dò tìm gì đó để truy ra tuyến. Hoặc nếu sheet "NhapDuLieu" có cột tuyến, thì quýnh vô RArr luôn.

 

[ndu96081631]

Đây chỉ là dữ liệu mẫu, dữ liệu thực tế khoảng 1000 dòng nên em không thể dùng công thức để trích lọc được vì ảnh hưởng đến tốc độ bảng tính.
Mong nhận được sự giúp đỡ từ gia đình GPE
Em xin chân thành cảm ơn!

Bài này cũng chẳng khó khăn gì! Dùng Dictionary Object để lọc duy nhất thôi
Có điều xin hỏi 1 câu: Cột B ở sheet Tham chieu ở đâu mà có?

 

[ptm0412]

Sub PlayWithArray()
Dim SArr, RArr, Dic1
Dim i As Long, s As Long, EndR As Long, n As Long
t = Timer
Set Dic1 = CreateObject("Scripting.Dictionary")
With Dic1
EndR = Sheet2.[b65000].End(xlUp).Row
SArr = Sheet2.Range("A2:C" & EndR).Value
ReDim RArr(1 To EndR - 1, 1 To 14)
For i = 1 To EndR - 1
    If Not .Exists(SArr(i, 2)) Then
        s = s + 1
        .Add SArr(i, 2), s
        RArr(s, 1) = SArr(i, 2)
        RArr(s, 2) = SArr(i, 3)
        RArr(s, 3) = SArr(i, 1)
        RArr(s, 14) = 1
    Else
        n = .Item(SArr(i, 2))
        RArr(n, 14) = RArr(n, 14) + 1
        RArr(n, RArr(n, 14) + 2) = SArr(i, 1)
    End If
Next
End With
Sheet1.[O4].Resize(s, 13) = RArr
Sheet1.[O1] = Timer - t
End Sub

10.000 dòng chỉ 0.1 giây.

 

[ptm0412]

Bài này cũng chẳng khó khăn gì! Dùng Dictionary Object để lọc duy nhất thôi
Có điều xin hỏi 1 câu: Cột B ở sheet Tham chieu ở đâu mà có?

Bài này mình đoán theo ý tác giả:
Sheet "Thamchieu" là DS duy nhất liệt kê tất cả 100 đầu xe, mỗi xe đã có tuyến sẵn.
Và tác giả muốn liệt kê chuyến dựa trên dữ liệu sheet kia. Xe nào không có chuyến nào thì để trống dòng đó.
Nếu để nguyên như vậy mà làm theo ý đó, sẽ tốn nhiều thời gian. Mình làm theo cách khác, (nếu cần thì sort lại), xe nào không có chuyến nào, thì không thể hiện.

 

[hoamattroicoi]

Cám ơn sư phụ nhiều ạ, kiến thức VBA của em chưa được bao nhiêu đã bị đóng băng mất rùi, huhu.

Thực ra em chỉ muốn hiển thị đúng giống như kết quả em đã hiển thị trong file, xe nào có lệnh thì liệt kê ra, xe nào không có thì để trống vì còn liên quan đến các tuyến nên em tách ra như thế cho dễ đối chiếu và giáp dữ liệu lại với bộ phận khác, vì bộ phận khác cũng có danh sách số xe và thứ tự giống hệt như sheet Tham chieu đó.

Em xin cảm ơn!

 

[Ba Tê]

Cám ơn sư phụ nhiều ạ, kiến thức VBA của em chưa được bao nhiêu đã bị đóng băng mất rùi, huhu.

Thực ra em chỉ muốn hiển thị đúng giống như kết quả em đã hiển thị trong file, xe nào có lệnh thì liệt kê ra, xe nào không có thì để trống vì còn liên quan đến các tuyến nên em tách ra như thế cho dễ đối chiếu và giáp dữ liệu lại với bộ phận khác, vì bộ phận khác cũng có danh sách số xe và thứ tự giống hệt như sheet Tham chieu đó.

Em xin cảm ơn!

Hổng biết dữ liệu vài ngàn dòng nó chạy ra sao chưa thử.
Nếu chạy hổng nổi thì tính sau.

 

[ptm0412]

Hổng biết dữ liệu vài ngàn dòng nó chạy ra sao chưa thử.
Nếu chạy hổng nổi thì tính sau.

Viết code theo Ba Tê là 2 vòng lặp lồng nhau.
100 xe, 1000 dòng dữ liệu, chạy 100.000 vòng lặp.
Đó là cách mà tôi nói từ đầu là "tốn nhiều thời gian"

Ngoài ra, 100.000 lần phải đọc sheet, offset cell, và ghi xuống sheet. Thao tác trên cell và sheet bao giờ cũng chậm.

Viết lại bài trên,thuật toán như cũ, nhưng nạp sheet "thamchieu" vào Dic chứ không nạp từ sheet kia.
Số vòng lặp (cũng 100 xe, 1000 dòng dữ liệu) là 1.100 vòng lặp.
Hơn nữa, quýnh bằg Array, không quýnh cell với sheet.

Sub PlayWithArray2()
Dim SArr1, SArr2, RArr, Dic1
Dim i As Long, s As Long, EndR1 As Long, n As Long
Dim EndR2 As Long
t = Timer

Set Dic1 = CreateObject("Scripting.Dictionary")
EndR1 = Sheet1.[B5000].End(xlUp).Row
SArr1 = Sheet1.Range("A4:A" & EndR1).Value
With Dic1
For i = 1 To EndR1 - 3
    .Add SArr1(i, 1), i
Next
EndR2 = Sheet2.[b65000].End(xlUp).Row
SArr2 = Sheet2.Range("A2:B" & EndR2).Value
ReDim RArr(1 To EndR2 - 1, 1 To 12)
For i = 1 To EndR2 - 1
        n = .Item(SArr2(i, 2))
        RArr(n, 12) = RArr(n, 12) + 1
        RArr(n, RArr(n, 12)) = SArr2(i, 1)
Next
End With
Sheet1.[C4].Resize(EndR2 - 1, 11) = RArr
Sheet1.[A1] = Timer - t
End Sub

100 xe và 500 dòng dữ liệu: 0.01 giây.

 

[hoamattroicoi]

Cám ơn sư phụ Ptm0412, bác Ba Tê và đại gia đình GPE thật nhiều!
Topic này có thể tích [Solver] được rồi!
Thanks again!

 

[ptm0412]

Cám ơn sư phụ Ptm0412, bác Ba Tê và đại gia đình GPE thật nhiều!
Topic này có thể tích [Solver] được rồi!
Thanks again!

Nếu vấn đề đã được giải quyết, thì là "Solved" chứ không phải "Solver"
Tuy vậy, khoan hãy nói thế, vì biết đâu còn có giải pháp khác hay hơn.

 

[ndu96081631]

Vậy bài toán này là: Dò tìm từ 1 bảng dữ liệu đang có trong 1 bảng khác và liệt kê ra
Thuật toán cũng giống như sư phụ Mỹ đã làm, nhưng em sẽ dùng sub có tham số truyền cho linh hoạt

Sub TransferData(ByVal SrcRng As Range, ByVal FindRng As Range, ByVal Left2Right As Boolean, ByVal Target As Range)
  Dim sArray, fArray, Arr(), tmp1 As String, tmp2 As String, tmp3 As String
  Dim i As Long, lsC As Long, ldC As Long, lC As Long, cMax As Long
  sArray = SrcRng.Resize(, 1).Value
  fArray = FindRng.Value
  lsC = IIf(Left2Right, 1, UBound(fArray, 2))
  ldC = IIf(Left2Right, UBound(fArray, 2), 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(sArray)
      If sArray(i, 1) <> "" Then
        tmp1 = CStr(sArray(i, 1))
        If Not .Exists(tmp1) Then .Add tmp1, i
      End If
    Next
    ReDim Arr(1 To .Count, 1 To 200)
    For i = 1 To UBound(fArray, 1)
      If fArray(i, lsC) <> "" Then
        tmp2 = CStr(fArray(i, lsC))
        tmp3 = CStr(fArray(i, ldC))
        If .Exists(tmp2) Then
          Arr(.Item(tmp2), 200) = Arr(.Item(tmp2), 200) + 1
          lC = Arr(.Item(tmp2), 200)
          Arr(.Item(tmp2), lC) = tmp3
          If cMax < lC Then cMax = lC
        End If
      End If
    Next
    Target.Resize(.Count, cMax).Value = Arr
  End With
End Sub

Sub Main()
  Dim SrcRng As Range, FindRng As Range
  Set SrcRng = Sheet1.Range("A4:A20000")
  Set FindRng = Sheet2.Range("A2:B20000")
  TransferData SrcRng, FindRng, False, Sheet1.Range("C4")
End Sub

Chỉ cần chú ý Sub Main, khai báo tham chiếu cho đúng là được
Cú pháp
TransferData Dữ liệu nguồn (1 cột) , Bảng dò tìm (có từ 2 cột trở lên), Tìm từ trái sang phải hoặc ngược lại, Vì trí cell đầu tiên đặt kết quả
Sau này dữ liệu có thay đổi (bố trí khác), chỉ việc chỉnh lại trong Sub Main là đủ (chỉnh 3 tham số SrcRng, FindRng và Target) còn code trong sub TransferData ta không cần bận tâm
--------------------
Sư phụ dùng End(xlUp) có thể sẽ bị sai nếu sheet Nhap du lieu đang được AutoFilter (mất 1 ít dữ liệu) ---> Ta cứ khai báo dư ra cũng chẳng hề gì

 

[ptm0412]

Đoạn code nạp Dic này của ndu có bẫy lỗi, dư, mà vẫn thiếu:

    For i = 1 To UBound(sArray)
      If sArray(i, 1) <> "" Then
        tmp1 = CStr(sArray(i, 1))
        If Not .Exists(tmp1) Then .Add tmp1, i
      End If
    Next

1. Nếu danh sách xe trong sheet "thamchieu" là duy nhất và không có ô trống, thì dư: Không cần xét sự tồn tại trong Dic và cũng không cần kiểm tra ô trống.

2. Nếu danh sách xe không duy nhất, và/hoặc có ô trống: Khi nạp Dic sẽ bỏ qua số xe trùng và ô trống. Mặc dù kết quả không ảnh hưởng vì đã đánh dấu dòng bằng "key", nhưng trên bảng kết quả: dòng chứa số xe trùng (từ lần 2 trở đi) sẽ bị bỏ trống, giống như 1 xe không chạy chuyến nào. Để tránh điều này, thiếu 1 đoạn code hoặc 1 thao tác bằng tay để loại bỏ trùng.

Nếu cho rằng đó là lỗi dữ liệu trùng, thì khi sửa lỗi dữ liệu xong, quay lại xem điều 1.

 

[ndu96081631]

Đoạn code nạp Dic này của ndu có bẫy lỗi, dư, mà vẫn thiếu:

    For i = 1 To UBound(sArray)
      If sArray(i, 1) <> "" Then
        tmp1 = CStr(sArray(i, 1))
        If Not .Exists(tmp1) Then .Add tmp1, i
      End If
    Next

1. Nếu danh sách xe trong sheet "thamchieu" là duy nhất và không có ô trống, thì dư: Không cần xét sự tồn tại trong Dic và cũng không cần kiểm tra ô trống.

2. Nếu danh sách xe không duy nhất, và/hoặc có ô trống: Khi nạp Dic sẽ bỏ qua số xe trùng và ô trống. Mặc dù kết quả không ảnh hưởng vì đã đánh dấu dòng bằng "key", nhưng trên bảng kết quả: dòng chứa số xe trùng (từ lần 2 trở đi) sẽ bị bỏ trống, giống như 1 xe không chạy chuyến nào. Để tránh điều này, thiếu 1 đoạn code hoặc 1 thao tác bằng tay để loại bỏ trùng.

Nếu cho rằng đó là lỗi dữ liệu trùng, thì khi sửa lỗi dữ liệu xong, quay lại xem điều 1.

Lý ra cột Số xe mà do code tự lọc ra sẽ không có vấn đề... Ở đây người dùng tự gõ, nếu sau khi chạy code thấy có sai sót thì đương nhiên người ta phải tự phát hiện và chỉnh lại dữ liệu nhập (Advanced Filter hay gì đó để lọc lại)
-----------------
Thật ra điều này em thấy ngay từ đầu rồi, nhưng nếu viết thật kỹ e rằng người "mới" sẽ không "nuốt" trôi ---> (thậm chí em còn không On Error Resume Next luôn) ---> Lúc đầu em viết ReDim Arr(1 To UBound(sArray, 1), 1 To 200) nhưng sau đó đã sửa lại thành ReDim Arr(1 To .Count, 1 To 200) cho gọn
Vậy, sau khi tác giả "tiêu hóa" xong, có thắc mắc gì nữa ta sẽ từ từ hoàn thiện sau
Ẹc... Ẹc...

 

[ptm0412]

Lúc đầu em viết ReDim Arr(1 To UBound(sArray, 1), 1 To 200) nhưng sau đó đã sửa lại thành ReDim Arr(1 To .Count, 1 To 200) cho gọn

Chính vì Redim Arr(1 To .Count, 1 To 200)mà khi gán xuống sheet bị thiếu dòng: Nếu dữ liệu trùng thì Dic.Count < UBound(sArray, 1)

Khi gán xuống sheet cũng Target.Resize(.Count, cMax), thiếu dòng chắc luôn. Ẹc ẹc!

Vậy, sau khi tác giả "tiêu hóa" xong, có thắc mắc gì nữa ta sẽ từ từ hoàn thiện sau

Tác giả này coi vậy chứ thông minh, giải thích như vậy là hiểu rồi. Vả lại, tác giả đã khẳng định List này còn dùng đối chiếu với các sheet khác, file khác, nên dữ liệu đã chuẩn.

Vấn đề là người khác đọc bài cơ. Người đọc topic này cần biết rằng: Dữ liệu sheet "thamchieu" phải chuẩn, không trùng và không bỏ trống.
Nếu không, chẳng thà dùng code bài #4, lấy kết quả ra chỗ khác.

 

[ndu96081631]

Vấn đề là người khác đọc bài cơ. Người đọc topic này cần biết rằng: Dữ liệu sheet "thamchieu" phải chuẩn, không trùng và không bỏ trống.
Nếu không, chẳng thà dùng code bài #4, lấy kết quả ra chỗ khác.

Nói thiệt, em vẫn ủng hộ cách đặt kết quả ở chổ khác ---> Lúc ấy code sẽ rất gọn
Còn như làm theo đúng yêu cầu bài này + Bẫy đủ thứ lỗi có thể xãy ra chắc còn phải mệt dài dài (đương nhiên, dữ liệu thật chuẩn thì không có gì phải bàn cả)

 

[chucuoi92]

Nếu vấn đề đã được giải quyết, thì là "Solved" chứ không phải "Solver"
Tuy vậy, khoan hãy nói thế, vì biết đâu còn có giải pháp khác hay hơn.

Em thấy trong bảng này dữ liệu chưa được chuẩn (chưa được sort) và nhập liệu (số lệnh) cũng không đồng nhất(cả text và number).
Nếu được sort và nhập (số lệnh) là number thì có thể dùng PIVOTTABLE kết hợp với cột phụ giải quyết bài này bằng cách "củ chuối" này "ngon lành"

 

[ptm0412]

"Củ chuối" này hay chứ!
Nhưng dữ liệu tác giả như thế này:
- Số chuyến là text. Nó có thể là 12/A gì đó nên không sum được. Khi mình giả lập dữ liệu lên 500 dòng để test code thì gõ ào ào vô nên nó là số
- Dữ liệu thực không có cột "Tuyến", tác giả đã nói từ đầu.

 

[ndu96081631]

"Củ chuối" này hay chứ!
Nhưng dữ liệu tác giả như thế này:
- Số chuyến là text. Nó có thể là 12/A gì đó nên không sum được. Khi mình giả lập dữ liệu lên 500 dòng để test code thì gõ ào ào vô nên nó là số
- Dữ liệu thực không có cột "Tuyến", tác giả đã nói từ đầu.

Mặc khác: Hình như HMTC muốn học VBA (chứ không phải không làm được bài này)

 

[kicon]

Em khai báo 1 mảng có 100 phần tử,em muốn gán phần tử thứ nhất là nội dung có sẵn trong ô A1 ....phần tử thứ 100 là nội dung có sẵn trong ô A100
Vậy em phải khai báo thế nào vậy các Anh Chị....Mong anh chị giúp đỡ....

 

[ndu96081631]

Em khai báo 1 mảng có 100 phần tử,em muốn gán phần tử thứ nhất là nội dung có sẵn trong ô A1 ....phần tử thứ 100 là nội dung có sẵn trong ô A100
Vậy em phải khai báo thế nào vậy các Anh Chị....Mong anh chị giúp đỡ....

Thì vầy thôi

Dim Arr
Arr = Range("A1:A100").Value

Với cách gán như thế thì:
- Biến Arr tự dưng trở thành mảng mà chẳng cần phải làm gì
- Thứ tự các phần tử trong Arr luôn trùng với thứ tự tại các cell A1:A100