Lọc dữ liệu bằng VBA

Tham gia ngày
21 Tháng chín 2007
Bài viết
9
Thích
0
Điểm
663
Tuổi
35
#1
Nhờ các bác giúp em vấn đề này với. EM không biết phải giải thích sao nữa.
Các bác xem file đính kèm nhé. Hic hic
Bài đã được tự động gộp:

Sao không add được file đính kèm các bác ơi
 

be09

Biên Hòa - Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
7,249
Thích
7,017
Điểm
560
Tuổi
61
#2
Bên dưới bài viết có nút đính kèm File (đó).

H_5.JPG
 
Lần chỉnh sửa cuối:

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,139
Thích
833
Điểm
210
#3

be09

Biên Hòa - Đồng Nai
Tham gia ngày
9 Tháng tư 2011
Bài viết
7,249
Thích
7,017
Điểm
560
Tuổi
61
#5
đây rồi. Nhờ các bác giúp em với nhé.
Tôi thiết kế lại cái mẫu cho thống nhất để nhập liệu theo chiều dọc cho thuận tiện việc truy vấn và tổng hợp báo cáo, nếu thông nhất thì ta tính tiếp.

Còn làm như kiểu bạn là chạy trước (viết code lằng nhằng quá).
 
Tham gia ngày
6 Tháng một 2011
Bài viết
8,242
Thích
9,237
Điểm
560
#8
Hình như ai cũng "anh với em" :rolleyes::rolleyes:
---------
Dim a, b, c, i, j, k As Long '// Khai báo biến như này thì chỉ có biến k có kiểu dữ liệu là Long, các biến còn lại là kiểu variant hết.

a = .Range("b" & Rows.Count).End(xlUp).Row
arr = .Range("A4").Resize(a, b).Value
'// Hình như là a-4 chứ nhỉ?

For i = 2 To UBound(arr, 1)
------For j = 6 To UBound(arr, 2) '// Thêm biến gán giá trị UBound(arr, 2) để tránh gọi lại nó (ubound(arr,1)-2+1) lần.

Còn cột [Đơn vị] và [Ghi chú] dùng công thức?
 

CHAOQUAY

Thành viên thường trực
Tham gia ngày
24 Tháng tám 2018
Bài viết
270
Thích
204
Điểm
60
#9
đây rồi. Nhờ các bác giúp em với nhé.
Thử code này xem sao
Mã:
Sub TrichLoc()
Dim KH, SP
Dim DM, KQ
Dim i As Long, j As Long, k
DM = Sheet3.Range("a4").CurrentRegion
ReDim KQ(1 To 5, 1 To UBound(DM, 2))
KH = Sheet2.Range("c3")
SP = Sheet2.Range("c4")
For i = 2 To UBound(DM)
    If DM(i, 2) = KH And DM(i, 4) = SP Then
        For j = 6 To UBound(DM, 2)
            If DM(i, j) <> "" Then
                k = k + 1
                KQ(1, k) = k
                KQ(2, k) = DM(2, j)
                KQ(3, k) = DM(i, 5)
                KQ(4, k) = DM(i, j)
            End If
        Next j
        ReDim Preserve KQ(1 To 5, 1 To k)
        Exit For
    End If
Next i
With Sheet2
.Range("a22").Resize(UBound(KQ, 2), UBound(KQ)) = Application.Transpose(KQ)
End With
End Sub
 
Tham gia ngày
21 Tháng chín 2007
Bài viết
9
Thích
0
Điểm
663
Tuổi
35
#10
Hình như ai cũng "anh với em" :rolleyes::rolleyes:
---------
Dim a, b, c, i, j, k As Long '// Khai báo biến như này thì chỉ có biến k có kiểu dữ liệu là Long, các biến còn lại là kiểu variant hết.

a = .Range("b" & Rows.Count).End(xlUp).Row
arr = .Range("A4").Resize(a, b).Value
'// Hình như là a-4 chứ nhỉ?

For i = 2 To UBound(arr, 1)
------For j = 6 To UBound(arr, 2) '// Thêm biến gán giá trị UBound(arr, 2) để tránh gọi lại nó (ubound(arr,1)-2+1) lần.

Còn cột [Đơn vị] và [Ghi chú] dùng công thức?
Bổ xung cho em điều kiện chọn "Danh mục sản phẩm" theo khách hang với nhé
Bài đã được tự động gộp:

Thử code này xem sao
Mã:
Sub TrichLoc()
Dim KH, SP
Dim DM, KQ
Dim i As Long, j As Long, k
DM = Sheet3.Range("a4").CurrentRegion
ReDim KQ(1 To 5, 1 To UBound(DM, 2))
KH = Sheet2.Range("c3")
SP = Sheet2.Range("c4")
For i = 2 To UBound(DM)
    If DM(i, 2) = KH And DM(i, 4) = SP Then
        For j = 6 To UBound(DM, 2)
            If DM(i, j) <> "" Then
                k = k + 1
                KQ(1, k) = k
                KQ(2, k) = DM(2, j)
                KQ(3, k) = DM(i, 5)
                KQ(4, k) = DM(i, j)
            End If
        Next j
        ReDim Preserve KQ(1 To 5, 1 To k)
        Exit For
    End If
Next i
With Sheet2
.Range("a22").Resize(UBound(KQ, 2), UBound(KQ)) = Application.Transpose(KQ)
End With
End Sub
Cảm ơn bác nhiều. Em đã chạy test code của bác.
Bài đã được tự động gộp:

Em cảm ơn anh snow25 nhiều nhé. đúng ý của em rồi.
Bổ xung cho em điều kiện chọn "Danh mục sản phẩm" theo khách hang với nhé
Bài đã được tự động gộp:

Thử code này xem sao
Mã:
Sub TrichLoc()
Dim KH, SP
Dim DM, KQ
Dim i As Long, j As Long, k
DM = Sheet3.Range("a4").CurrentRegion
ReDim KQ(1 To 5, 1 To UBound(DM, 2))
KH = Sheet2.Range("c3")
SP = Sheet2.Range("c4")
For i = 2 To UBound(DM)
    If DM(i, 2) = KH And DM(i, 4) = SP Then
        For j = 6 To UBound(DM, 2)
            If DM(i, j) <> "" Then
                k = k + 1
                KQ(1, k) = k
                KQ(2, k) = DM(2, j)
                KQ(3, k) = DM(i, 5)
                KQ(4, k) = DM(i, j)
            End If
        Next j
        ReDim Preserve KQ(1 To 5, 1 To k)
        Exit For
    End If
Next i
With Sheet2
.Range("a22").Resize(UBound(KQ, 2), UBound(KQ)) = Application.Transpose(KQ)
End With
End Sub
Bác ơi.
Cột đơn vị lấy ở sheet "DM_Vattu" cơ ạ
 
Lần chỉnh sửa cuối:
Tham gia ngày
21 Tháng chín 2007
Bài viết
9
Thích
0
Điểm
663
Tuổi
35
#11
Em cảm ơn anh snow25 nhiều nhé. đúng ý của em rồi.
Bác Snow25 ơi.
Em định cho công thức cột đơn vị nhưng khi chạy chương trình thì công thức bị xóa tất.
Em đã định vị lại cột clear nhưng vẫn không được '.Range("a7:e1000").ClearContents
 

CHAOQUAY

Thành viên thường trực
Tham gia ngày
24 Tháng tám 2018
Bài viết
270
Thích
204
Điểm
60
#12
Cột đơn vị lấy ở sheet "DM_Vattu" cơ ạ
Test lại lần nữa xem sao
Mã:
Sub TrichLoc()
Dim KH, SP
Dim DM, DMVT, KQ
Dim i As Long, j As Long, k, z
DM = Sheet3.Range("a4").CurrentRegion
DMVT = Sheet1.Range("a3").CurrentRegion
ReDim KQ(1 To 5, 1 To UBound(DM, 2))
KH = Sheet2.Range("c3")
SP = Sheet2.Range("c4")
For i = 2 To UBound(DM)
    If DM(i, 2) = KH And DM(i, 4) = SP Then
        For j = 6 To UBound(DM, 2)
            If DM(i, j) <> "" Then
                k = k + 1
                KQ(1, k) = k
                KQ(2, k) = DM(2, j)
                KQ(4, k) = DM(i, j)
                For z = 2 To UBound(DMVT)
                    If DMVT(z, 2) = DM(2, j) Then
                        KQ(3, k) = DMVT(z, 4)
                        Exit For
                    End If
                Next z
            End If
        Next j
        ReDim Preserve KQ(1 To 5, 1 To k)
        Exit For
    End If
Next i
With Sheet2
.Range("a22").Resize(UBound(KQ, 2), UBound(KQ)) = Application.Transpose(KQ)
End With
End Sub
Làm xong đăng lên mới thấy bài 6, tính thôi nhưng bạn hỏi nên làm thêm 1 lần này.
Chúc may mắn ! :)
 

snow25

Thành viên tích cực
Tham gia ngày
24 Tháng bảy 2018
Bài viết
1,139
Thích
833
Điểm
210
#13
Hình như ai cũng "anh với em" :rolleyes::rolleyes:
---------
Dim a, b, c, i, j, k As Long '// Khai báo biến như này thì chỉ có biến k có kiểu dữ liệu là Long, các biến còn lại là kiểu variant hết.

a = .Range("b" & Rows.Count).End(xlUp).Row
arr = .Range("A4").Resize(a, b).Value
'// Hình như là a-4 chứ nhỉ?

For i = 2 To UBound(arr, 1)
------For j = 6 To UBound(arr, 2) '// Thêm biến gán giá trị UBound(arr, 2) để tránh gọi lại nó (ubound(arr,1)-2+1) lần.

Còn cột [Đơn vị] và [Ghi chú] dùng công thức?
đúng rồi cảm ơn bạn
CHAOQUAY
vâng bác cháu không để ý à
befaint

nhé viết nhanh quá không để ý cái a-4 mà nó chỉ thừa mấy vòng lặp thôi :D
Bài đã được tự động gộp:

Bác Snow25 ơi.
Em định cho công thức cột đơn vị nhưng khi chạy chương trình thì công thức bị xóa tất.
Em đã định vị lại cột clear nhưng vẫn không được '.Range("a7:e1000").ClearContents
tại vì đây là gắn theo mảng nên xóa cũng chỉ là 1 phần thôi vì nó còn mảng nữa.bạn phải gán đơn vị tính vào mảng ạ,tại đề bài đưa ra là không có đơn vị tính nên không cho vào ạ.
 
Lần chỉnh sửa cuối:
Tham gia ngày
21 Tháng chín 2007
Bài viết
9
Thích
0
Điểm
663
Tuổi
35
#14
đúng rồi cảm ơn bạn
CHAOQUAY
vâng bác cháu không để ý à
befaint

nhé viết nhanh quá không để ý cái a-4 mà nó chỉ thừa mấy vòng lặp thôi :D
Bài đã được tự động gộp:


tại vì đây là gắn theo mảng nên xóa cũng chỉ là 1 phần thôi vì nó còn mảng nữa.bạn phải gán đơn vị tính vào mảng ạ,tại đề bài đưa ra là không có đơn vị tính nên không cho vào ạ.
Thế nhờ bác bổ xung them cho em nhé.
Thêm cả cái này nữa :Bổ xung cho em điều kiện chọn "Danh mục sản phẩm" theo khách hàng với nhé
Bài đã được tự động gộp:

Test lại lần nữa xem sao
Mã:
Sub TrichLoc()
Dim KH, SP
Dim DM, DMVT, KQ
Dim i As Long, j As Long, k, z
DM = Sheet3.Range("a4").CurrentRegion
DMVT = Sheet1.Range("a3").CurrentRegion
ReDim KQ(1 To 5, 1 To UBound(DM, 2))
KH = Sheet2.Range("c3")
SP = Sheet2.Range("c4")
For i = 2 To UBound(DM)
    If DM(i, 2) = KH And DM(i, 4) = SP Then
        For j = 6 To UBound(DM, 2)
            If DM(i, j) <> "" Then
                k = k + 1
                KQ(1, k) = k
                KQ(2, k) = DM(2, j)
                KQ(4, k) = DM(i, j)
                For z = 2 To UBound(DMVT)
                    If DMVT(z, 2) = DM(2, j) Then
                        KQ(3, k) = DMVT(z, 4)
                        Exit For
                    End If
                Next z
            End If
        Next j
        ReDim Preserve KQ(1 To 5, 1 To k)
        Exit For
    End If
Next i
With Sheet2
.Range("a22").Resize(UBound(KQ, 2), UBound(KQ)) = Application.Transpose(KQ)
End With
End Sub
Làm xong đăng lên mới thấy bài 6, tính thôi nhưng bạn hỏi nên làm thêm 1 lần này.
Chúc may mắn ! :)
Cảm ơn bác nhiều.
 
Tham gia ngày
6 Tháng một 2011
Bài viết
8,242
Thích
9,237
Điểm
560
#16
không hiểu lắm bạn nói rõ xem nào mà làm file mẫu nữa nhé
Nghĩa là bạn ấy muốn làm hai việc nữa:
1. Điền đơn vị vào cột đơn vị
2. Khi gõ tên khách hàng vào ô C3 thì ở ô C4 có một Data validation - list "Danh mục sản phẩm" tương ứng để chọn.
 
Tham gia ngày
21 Tháng chín 2007
Bài viết
9
Thích
0
Điểm
663
Tuổi
35
#17
Nghĩa là bạn ấy muốn làm hai việc nữa:
1. Điền đơn vị vào cột đơn vị
2. Khi gõ tên khách hàng vào ô C3 thì ở ô C4 có một Data validation - list "Danh mục sản phẩm" tương ứng để chọn.
EM làm được rồi. Cảm ơn anh đã phản hồi
 
Top