Xin hỗ trợ lọc dữ liệu theo điều kiện bằng VBA. Một khách hàng có 2 loại bệnh.

[anh1234]

Dear cả nhà
Em có 1 file ( gồm 100 cột, khoảng 100.000 dòng)
Đề bài:
Sheet dữ liệu gồm có 100 cột, 100.000 dòng.
1. Tìm các khách hàng ( theo mã khách hàng) : 1 khách hàng có từ 2 loại bệnh trở lên( 2,3,4,5 loại bệnh. Có tất cả 5 loại bệnh. (1-2-3-4-5).
Copy toàn bộ dữ liệu trên 1 dòng của khách hàng thỏa mãn điều kiện ( 1 khách hàng có 2 loại bênh trở lên) sang sheet mới. Copy toàn bộ các dòng cùng mã khách hàng thuộc ds vừa lọc được.
( tương tự sheet kết quả).
File mẫu em chỉ để 14 cột và 63 dòng cho nhẹ, nhưng data của em phải 100 cột, 100.000 dòng.
2. Tạo ô điền tham chiếu cột mã khác hàng và cột loại bệnh để xác định đúng dữ liệu trong công thức VBA khi có sự thay đổi.
Ở ví dụ trên thì ô đó sẽ điền Cột mã khách hàng"Cột C" và cột Bệnh "Cột D". ( Thay vì việc phải sửa công thức thì chỉ cần điền thông tin bên ngoài và ấn click
Tạo nút Run để chạy công thức ạ
Thay vì việc phải sửa công thức thì chỉ cần điền thông tin bên ngoài và ấn click ( cái này đòi hỏi hơi quá, nhưng đã tham thì phải ko thâm ạ!!
Em xin đã tạ các pro ạ.

 

[anh1234]

Code này, nếu xử lý dữ liệu 100.000 dòng thì em thấy nhanh hơn, nhưng em nhìn hơi rườm rà, ko biết có cách nào để gộp 2 cái vòng lặp i vào một không nhỉ, nhờ mấy anh chị trên đây giúp đỡ để tối ưu hơn.

Option Base 1
Option Explicit
Sub GPE()
Dim Arr1(), Arr2()
Dim i,  k, l, a, b As Integer
Arr1 = Sheet1.UsedRange
For i = 1 To UBound(Arr1, 1)
      a = WorksheetFunction.CountIf(Sheet1.Range("C:C"), Arr1(i, 3))
      b = WorksheetFunction.SumIfs(Sheet1.Range("D:D"), Sheet1.Range("C:C"), Arr1(i, 3))
      If a > 1 And b > a Then k = k + 1
Next i
ReDim Arr2(1 To k, 1 To UBound(Arr1, 2))
k = 0
For i = 1 To UBound(Arr1, 1)
      a = WorksheetFunction.CountIf(Sheet1.Range("C:C"), Arr1(i, 3))
      b = WorksheetFunction.SumIfs(Sheet1.Range("D:D"), Sheet1.Range("C:C"), Arr1(i, 3))
      If a > 1 And b > a Then
            k = k + 1
            For l = 1 To UBound(Arr1, 2)
                  Arr2(k, l) = Arr1(i, l)
            Next l
      End If
Next i
Sheet3.Range("A2").Resize(UBound(Arr2, 1), UBound(Arr2, 2)) = Arr2
End Sub

Em cám ơn bác, Em đang test thử dữ liệu của em xem có lỗi gì không.
Em muốn làm thêm textbox để xác định vùng dữ liệu để chạy và nút run marco thì thêm code như nào ạ.
Ví dụ Trong file của em Cột "Mã KH" và cột " Loại bênh" không phải là cột C và D. Em muốn tạo chỗ nhập dữ liệu tham chiếu để công thức có thể tự xác định đó ạ. Sau chỉ cần click vào nút run là tự chạy ra sheet kết quả mới luôn

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

Thì bài 18 tôi nêu vầy:
Vậy thì đưa phải cái File từ phần mềm xuất ra với tiêu đề đầy đủ thì mới hình dung được cấu trúc của nó rồi mới tính đến việc khác, còn đưa tiêu đề nữa chừng là thua, không ai hình dung được những cột còn thiếu nó là cái gì?

Dạ vâng ạ

 

[gttrongvn]

Em cám ơn bác, Em đang test thử dữ liệu của em xem có lỗi gì không.
Em muốn làm thêm textbox để xác định vùng dữ liệu để chạy và nút run marco thì thêm code như nào ạ.
Ví dụ Trong file của em Cột "Mã KH" và cột " Loại bênh" không phải là cột C và D. Em muốn tạo chỗ nhập dữ liệu tham chiếu để công thức có thể tự xác định đó ạ. Sau chỉ cần click vào nút run là tự chạy ra sheet kết quả mới luôn

Vậy bạn gửi file có dữ liệu đầy đủ hơn để mọi người xử lý, chứ đưa cái file giả lên rồi người ta xử lý xong, xong rồi ko phải như bạn muốn, chỉnh tới chỉnh lui mất thời gian.

 

[gttrongvn]

Có nhiều dòng giống nhau đều có khả năng xảy ra lỗi mà bạn.

Mình tạm thời thêm điều kiện a=2 và b=4, đợi chủ thớt cho file hoàn chỉnh để chạy thử xem còn lỗi nào phát sinh ko.

Sub test()
Dim Arr1(), Arr2()
Dim i, k, l, a, b As Integer
Arr1 = Sheet1.UsedRange
ReDim Arr2(1 To UBound(Arr1, 1), 1 To UBound(Arr1, 2))
For i = 1 To UBound(Arr1, 1)
      a = WorksheetFunction.CountIf(Sheet1.Range("C:C"), Arr1(i, 3))
      b = WorksheetFunction.SumIfs(Sheet1.Range("D:D"), Sheet1.Range("C:C"), Arr1(i, 3))
      If a > 1 And b > a Then
            If a = 2 And b = 4 Then GoTo tiep
            k = k + 1
            For l = 1 To UBound(Arr1, 2)
                    Arr2(k, l) = Arr1(i, l)
            Next l
      End If
tiep:
Next i
Sheet3.Range("A2").Resize(UBound(Arr2, 1), UBound(Arr2, 2)) = Arr2
End Sub

 

[Hau151978]

Mình tạm thời thêm điều kiện a=2 và b=4, đợi chủ thớt cho file hoàn chỉnh để chạy thử xem còn lỗi nào phát sinh ko.

Sub test()
Dim Arr1(), Arr2()
Dim i, k, l, a, b As Integer
Arr1 = Sheet1.UsedRange
ReDim Arr2(1 To UBound(Arr1, 1), 1 To UBound(Arr1, 2))
For i = 1 To UBound(Arr1, 1)
      a = WorksheetFunction.CountIf(Sheet1.Range("C:C"), Arr1(i, 3))
      b = WorksheetFunction.SumIfs(Sheet1.Range("D:D"), Sheet1.Range("C:C"), Arr1(i, 3))
      If a > 1 And b > a Then
            If a = 2 And b = 4 Then GoTo tiep
            k = k + 1
            For l = 1 To UBound(Arr1, 2)
                    Arr2(k, l) = Arr1(i, l)
            Next l
      End If
tiep:
Next i
Sheet3.Range("A2").Resize(UBound(Arr2, 1), UBound(Arr2, 2)) = Arr2
End Sub

Thế nếu 4 dòng giống nhau cùng mã bệnh là 3 thì a=4 b=12 thì sao bạn? Nói chung 1 kết quả đếm so sánh với tổng có vẻ không ổn. Sao bạn không so sánh countif theo mã khách hàng với countifs theo mã khách hàng và loại bệnh.

 

[gttrongvn]

Thế nếu 4 dòng giống nhau cùng mã bệnh là 3 thì a=4 b=12 thì sao bạn? Nói chung 1 kết quả đếm so sánh với tổng có vẻ không ổn. Sao bạn không so sánh countif theo mã khách hàng với countifs theo mã khách hàng và loại bệnh.

Vậy tức là 2 bệnh 2, 3 bệnh 3, 4 bệnh 4, 5 bệnh 5 sẽ xảy ra lỗi, Vậy sửa dòng có điều kiện If a = 2 And b = 4 thành If a * a = b thử xem,chiều về mình sẽ tìm hướng xử lý, bạn có thể cho mình xem code theo gợi ý hướng giải quyết của bạn được ko.

 

[Hau151978]

Vậy tức là 2 bệnh 2, 3 bệnh 3, 4 bệnh 4, 5 bệnh 5 sẽ xảy ra lỗi. Chiều về mình sẽ tìm hướng xử lý, bạn có thể cho mình xem code theo gợi ý hướng giải quyết của bạn được ko.

Mình không có máy tính nên không viết cụ thể được.
Code của bạn

a = WorksheetFunction.CountIf(Sheet1.Range("C:C"), Arr1(i, 3))
b = WorksheetFunction.SumIfs(Sheet1.Range("D:D"), Sheet1.Range("C:C"), Arr1(i, 3))
sửa thành
a = WorksheetFunction.CountIf(Sheet1.Range("C:C"), Arr1(i, 3))
b = WorksheetFunction.CountIfs(Sheet1.Range("D:D"), arr1(i,4), Sheet1.Range("C:C"), Arr1(i, 3))

So sánh nếu a>b là có nhiều loại bệnh.

 

[gttrongvn]

So sánh nếu a>b là có nhiều loại bệnh.

Mình phát hiện ra rồi, để chiều về mình tìm hướng khác thử xem.

 

[truongvu317]

Activate đúng sheet thì sao lại tương tác vào sheet không chuẩn được bạn

Giả sử việc activate bị lỗi do nguyên nhân nào đó, thế là cái sheet ta dự tính tương tác nó đã thay đổi ngoài ý muôn.

(*) tôi không rõ bài #5 muốn nói "khi viết code lớn" là như thế nào cho nên không thể bàn thêm nữa.

Nó to hơn con muỗi chút ý anh, chỉ cần có nhiều thủ tục viết theo cái kiểu active linh tinh là sẽ thấy rõ ngay.

 

[Hau151978]

Giả sử việc activate bị lỗi do nguyên nhân nào đó, thế là cái sheet ta dự tính tương tác nó đã thay đổi ngoài ý muôn.

Nó to hơn con muỗi chút ý anh, chỉ cần có nhiều thủ tục viết theo cái kiểu active linh tinh là sẽ thấy rõ ngay.

Mình chưa rõ khi nào thì activate sheet gây lỗi trừ khi sheet đó ẩn.
Sử dụng With - End With rất dễ lỗi khi ta quên 1 dấu chấm.

 

[truongvu317]

Mình chưa rõ khi nào thì activate sheet gây lỗi trừ khi sheet đó ẩn.

HỎi một câu đơn giản thui, là nếu không activate thì bạn có thể viết code được không?

 

[Hau151978]

HỎi một câu đơn giản thui, là nếu không activate thì bạn có thể viết code được không?

Tất nhiên là được nhưng mình làm gì đó phải dựa trên bằng chứng cụ thể.
Ví dụ test của mình dưới đây code đơn giản copy range khoảng 5000 dòng x 43 cột sang sheet khác dùng mảng bị lỗi ngay. Sau khi tra Google không được cuối cùng mình cũng tìm ra chỗ gây lỗi (mặc dù vẫn chưa biết tại sao).

 

[truongvu317]

Tất nhiên là được nhưng mình làm gì đó phải dựa trên bằng chứng cụ thể.
.

Nếu đã làm được thì tội gì phải active cho nó mất công ra nhỉ?
Không dùng mảng thì dùng cái ".copy" có sao đâu, cái này nó chả cần phải active gì gì đó vẫn được cơ mà.

Option Explicit

Sub test()
Dim arrData()


Dim strDiaChi As String
strDiaChi = "$A$1:$AQ$5768"

arrData = Sheet3.Range(strDiaChi).Value2
Sheet2.Range(strDiaChi).Value2 = arrData

'Sheet3.Range("$A$1:$AQ$5768").Copy Sheet2.Range("A1")
End Sub

 

[Hau151978]

Nếu đã làm được thì tội gì phải active cho nó mất công ra nhỉ?
Không dùng mảng thì dùng cái ".copy" có sao đâu, cái này nó chả cần phải active gì gì đó vẫn được cơ mà.

Option Explicit

Sub test()
Dim arrData()


Dim strDiaChi As String
strDiaChi = "$A$1:$AQ$5768"

arrData = Sheet3.Range(strDiaChi).Value2
Sheet2.Range(strDiaChi).Value2 = arrData

'Sheet3.Range("$A$1:$AQ$5768").Copy Sheet2.Range("A1")
End Sub

Ý mình muốn tìm hiểu ở đây là tại sao dùng .value thì lỗi mà .value2 lại được còn copy chỉ là giả định thôi.

 

[VetMini]

Nó to hơn con muỗi chút ý anh, chỉ cần có nhiều thủ tục viết theo cái kiểu active linh tinh là sẽ thấy rõ ngay.

Ông nội tôi tên là Nhiều, Bà nội tôi tên là Nhớn (tiếng Nam là Lớn). Vì vậy mõi lần nghe đến cái từ "nhiều" [dữ liệu], hay [project] "lớn" là tôi giật nẩy cả mình.
Đối với bài này, cốt kiếc gì đó cũng chỉ là đồ chữa cháy. Người ta chỉ chú trọng vào việc giảm số vòng lặp để "tối ưu" code.
Nói chuyện ắc tiêu ắc tiếc quá thừa thải.