Nhờ sửa lại code lọc dữ liệu có điều kiện!

[theanhst92]

Kính gửi mọi người trên diễn đàn!
Em đã tìm hiểu trên diễn đàn và đã tìm thấy bộ mã lọc có điều kiện. nhưng mã lọc này chưa đúng với yêu cầu sau khi lọc. vì khi lọc xong sẽ có 2 cột được chuyển từ cột sang hàng. Mong mọi người sửa lại giúp em với ạ! em xin cảm ơn!
Hình ảnh 1: bộ lọc giá trị bằng mã.

image 2: Mong muốn lọc:

 

[tigertiger]

Kính gửi mọi người trên diễn đàn!
Em đã tìm hiểu trên diễn đàn và đã tìm thấy bộ mã lọc có điều kiện. nhưng mã lọc này chưa đúng với yêu cầu sau khi lọc. vì khi lọc xong sẽ có 2 cột được chuyển từ cột sang hàng. Mong mọi người sửa lại giúp em với ạ! em xin cảm ơn!
Hình ảnh 1: bộ lọc giá trị bằng mã.
View attachment 250703
image 2: Mong muốn lọc:
View attachment 250705

Bạn tìm hiểu và sử dụng pivotTable, sẽ có kết quả như ý

 

[theanhst92]

Bạn tìm hiểu và sử dụng pivotTable, sẽ có kết quả như ý

Em cũng đã dùng thư pivottable và cũng đã cho ra kết quả nhưng khi lọc theo loại sẽ dẫn đến tăng số lượng cột. mong được bác giúp đỡ!

 

[Nhattanktnn]

Em cũng đã dùng thư pivottable và cũng đã cho ra kết quả nhưng khi lọc theo loại sẽ dẫn đến tăng số lượng cột. mong được bác giúp đỡ!
View attachment 250708

Pivot :

 

[theanhst92]

Pivot :

em cũng đã ghi chú ở bài #3 là do mã loại không cố định là A;B;C;D mà còn có thể là 1,2,3,4,5 hoặc bất kỳ một loại nào khác cho nên ở trường hợp L002 sẽ bị tăng số lượng cột. ảnh hưởng đến trình bày báo cáo theo mẫu ạ!

 

[Nhattanktnn]

em cũng đã ghi chú ở bài #3 là do mã loại không cố định là A;B;C;D mà còn có thể là 1,2,3,4,5 hoặc bất kỳ một loại nào khác cho nên ở trường hợp L002 sẽ bị tăng số lượng cột. ảnh hưởng đến trình bày báo cáo theo mẫu ạ!

Trường hợp này dùng Power Query ngon lành (nhưng tôi cùi bắp, biết nó làm được thôi chứ tôi không làm được)
Xài tạm code này xem sao (1 loại không nhập 2 lần đấy chứ? vì tôi chưa làm trường hợp đó)

Option Explicit
Sub Loc()
Dim sArr(), darr(), Lr As Long, I As Long, J As Long, K As Long, R As Long
Dim Dic As Object, Temp(), TmpStr As String, N As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
    Lr = .Cells(Rows.Count, 1).End(xlUp).Row
    sArr = .Range("A3:F" & Lr).Value
    R = UBound(sArr, 1)
End With
ReDim darr(1 To R, 1 To 15)
For I = 1 To R
    TmpStr = sArr(I, 1) & "#" & sArr(I, 2)
    If Not Dic.exists(TmpStr) Then
        K = K + 1: ReDim Temp(1 To 12)
        Temp(1) = sArr(I, 5): Temp(6) = sArr(I, 6): Temp(11) = 1: Temp(12) = K
        Dic.Add (TmpStr), Temp
        For N = 1 To 4
            darr(K, N) = sArr(I, N)
        Next
            darr(K, 5) = Temp(1)
            darr(K, 10) = Temp(6)
    Else
        Temp = Dic.Item(TmpStr): J = Temp(11) + 1
        Temp(J) = sArr(I, 5): Temp(J + 5) = sArr(I, 6): Temp(11) = J
        Dic.Item(TmpStr) = Temp
        For N = 1 To 10
            darr(Temp(12), N + 4) = Temp(N)
        Next
    End If
Next
With Sheets("Loc")
    .Range("A2").Resize(Rows.Count - 1, 14).ClearContents
    .Range("A2").Resize(Dic.Count, 14) = darr
End With
End Sub

 

[theanhst92]

Trường hợp này dùng Power Query ngon lành (nhưng tôi cùi bắp, biết nó làm được thôi chứ tôi không làm được)
Xài tạm code này xem sao (1 loại không nhập 2 lần đấy chứ? vì tôi chưa làm trường hợp đó)

Option Explicit
Sub Loc()
Dim sArr(), darr(), Lr As Long, I As Long, J As Long, K As Long, R As Long
Dim Dic As Object, Temp(), TmpStr As String, N As Long
Set Dic = CreateObject("Scripting.Dictionary")
With Sheets("Data")
    Lr = .Cells(Rows.Count, 1).End(xlUp).Row
    sArr = .Range("A3:F" & Lr).Value
    R = UBound(sArr, 1)
End With
ReDim darr(1 To R, 1 To 15)
For I = 1 To R
    TmpStr = sArr(I, 1) & "#" & sArr(I, 2)
    If Not Dic.exists(TmpStr) Then
        K = K + 1: ReDim Temp(1 To 12)
        Temp(1) = sArr(I, 5): Temp(6) = sArr(I, 6): Temp(11) = 1: Temp(12) = K
        Dic.Add (TmpStr), Temp
        For N = 1 To 4
            darr(K, N) = sArr(I, N)
        Next
            darr(K, 5) = Temp(1)
            darr(K, 10) = Temp(6)
    Else
        Temp = Dic.Item(TmpStr): J = Temp(11) + 1
        Temp(J) = sArr(I, 5): Temp(J + 5) = sArr(I, 6): Temp(11) = J
        Dic.Item(TmpStr) = Temp
        For N = 1 To 10
            darr(Temp(12), N + 4) = Temp(N)
        Next
    End If
Next
With Sheets("Loc")
    .Range("A2").Resize(Rows.Count - 1, 14).ClearContents
    .Range("A2").Resize(Dic.Count, 14) = darr
End With
End Sub

Em cảm ơn ạ!
Nhưng mã này đã giải quyết được chế độ chuyển dữ liệu từ cột thành hàng chứ chưa lọc được theo điều kiện ở cột A mà nó lọc hết tất cả giá trị. có cách nào để chèn điều kiện vào không ạ!

 

[Nhattanktnn]

Em cảm ơn ạ!
Nhưng mã này đã giải quyết được chế độ chuyển dữ liệu từ cột thành hàng chứ chưa lọc được theo điều kiện ở cột A mà nó lọc hết tất cả giá trị. có cách nào để chèn điều kiện vào không ạ!

Bạn kiểm tra lại xem vậy được chưa?
Có thể bạn không bấm gì cũng không sao, nhưng tôi bỏ thời gian giúp bạn, dù nó chưa đạt mong muốn thì cũng không nên bấm cái hình này, nó cho tôi cảm giác tôi đang phải làm cho bạn và được bạn "đồng ý ừ tạm được"

 

[theanhst92]

Bạn kiểm tra lại xem vậy được chưa?
Có thể bạn không bấm gì cũng không sao, nhưng tôi bỏ thời gian giúp bạn, dù nó chưa đạt mong muốn thì cũng không nên bấm cái hình này, nó cho tôi cảm giác tôi đang phải làm cho bạn và được bạn "đồng ý ừ tạm được" View attachment 250732

Em xin lỗi. có thể cách thể hiện thao tác gây hiểu nhầm ý của em ạ! mong bác thông cảm. lên trên này được mọi người giúp đỡ là em cảm thấy rất biết ơn rồi ạ!

 

[theanhst92]

Bạn kiểm tra lại xem vậy được chưa?
Có thể bạn không bấm gì cũng không sao, nhưng tôi bỏ thời gian giúp bạn, dù nó chưa đạt mong muốn thì cũng không nên bấm cái hình này, nó cho tôi cảm giác tôi đang phải làm cho bạn và được bạn "đồng ý ừ tạm được" View attachment 250732

ReDim darr(1 To R, 1 To 15)
For i = 1 To R
    If sArr(i, 1) = Sheets("Loc").Range("B1").Value Then
        TmpStr = sArr(i, 1) & "#" & sArr(i, 2)
        If Not Dic.exists(TmpStr) Then
            K = K + 1: ReDim Temp(1 To 32)
            Temp(1) = sArr(i, 5): Temp(6) = sArr(i, 6): Temp(11) = 1: Temp(12) = K
            Dic.Add (TmpStr), Temp
            For N = 1 To 4
                darr(K, N) = sArr(i, N)
            Next
                darr(K, 5) = Temp(1)
                darr(K, 10) = Temp(6)
        Else
            Temp = Dic.Item(TmpStr): J = Temp(11) + 1
            Temp(J) = sArr(i, 5): Temp(J + 5) = sArr(i, 6): Temp(11) = J
            Dic.Item(TmpStr) = Temp
            For N = 1 To 10
                darr(Temp(12), N + 4) = Temp(N)
            Next
        End If
    End If
Next

em thấy code về cơ bản đã thực hiện nhưng nhưng nếu lỡ nhập thêm 1 loại thì sẽ không tính đúng. nếu em sửa thành 15 loại và 15 số lượng thì đoạn mã này thay số như nào ạ!
Cập nhật: Đã tự sửa lại được!

 

[hocexcel_1991]

Kính gửi mọi người trên diễn đàn!
Em đã tìm hiểu trên diễn đàn và đã tìm thấy bộ mã lọc có điều kiện. nhưng mã lọc này chưa đúng với yêu cầu sau khi lọc. vì khi lọc xong sẽ có 2 cột được chuyển từ cột sang hàng. Mong mọi người sửa lại giúp em với ạ! em xin cảm ơn!
Hình ảnh 1: bộ lọc giá trị bằng mã.
View attachment 250703
image 2: Mong muốn lọc:
View attachment 250705

Thử dùng PowerQuery

 

[theanhst92]

Thử dùng PowerQuery
View attachment 250737

em đã tham khảo nhưng vẫn không biết cách làm và cũng không rõ cách này nó có tự cập nhật số liệu thi điều kiện thay đổi không ạ?