Tạo danh sách duy nhất. Thay đổi theo điều kiện lọc

[n0thing1988]

Chào các anh chị trên GPE
Vấn đề của em không biết đã có bài viết nào như vậy chưa. Nay em gửi file lên xin mọi ng trợ giúp
Mong anh chị xem file và giúp đỡ em.

 

[hpkhuong]

Chào các anh chị trên GPE
Vấn đề của em không biết đã có bài viết nào như vậy chưa. Nay em gửi file lên xin mọi ng trợ giúp
Mong anh chị xem file và giúp đỡ em.

Pivot Table đi chàng.........code kiết chi khổ thể. Pivot vài giây là ra rồi. Muốn kéo thả gì mà hok được

 

[Let'GâuGâu]

Chào các anh chị trên GPE
Vấn đề của em không biết đã có bài viết nào như vậy chưa. Nay em gửi file lên xin mọi ng trợ giúp
Mong anh chị xem file và giúp đỡ em.

Sub BonjourVietNam()
Dim nx As Variant, dic As Object, i, tong As Long
With Sheets("NX")
    nx = .Range(.[c7], .[c7].End(4)).Resize(, 14).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(nx)
    If nx(i, 12) = Sheet3.[n3] Then
        If Not dic.exists(nx(i, 3)) Then
            dic.Add nx(i, 3), nx(i, 9)
            tong = tong + nx(i, 9)
        Else
            dic.Item(nx(i, 3)) = dic.Item(nx(i, 3)) + nx(i, 9)
            tong = tong + nx(i, 9)
        End If
    End If
Next

If dic.Count Then
Application.ScreenUpdating = False
With Sheet3
    .[a9:c1000].ClearContents
    .[a9].Resize(dic.Count) = "=row()-8"
    .[a9].Resize(dic.Count).Value = [a9].Resize(dic.Count).Value
    .[b9].Resize(dic.Count).Value = Application.Transpose(dic.keys)
    .[C9].Resize(dic.Count).Value = Application.Transpose(dic.items)
    .[b9].End(4).Offset(1).Value = "Tong"
    .[C9].End(4).Offset(1).Value = tong
End With
Application.ScreenUpdating = True
End If

End Sub

 

[n0thing1988]

Pivot Table đi chàng.........code kiết chi khổ thể. Pivot vài giây là ra rồi. Muốn kéo thả gì mà hok được

File này em cũng muốn Pivot table lắm. Nhưng khổ nỗi còn liên quan đến trình bày theo biểu mẫu nữa. Em chỉ muốn làm cho cột B thôi. Còn các cột khác em có công thức sẵn rồi. Cảm ơn anh đã góp ý ạ
@ Let's gâu gâu. Code chạy rất tốt. Cảm ơn anh nhiều

 

[hpkhuong]

Sub BonjourVietNam()
Dim nx As Variant, dic As Object, i, tong As Long
With Sheets("NX")
    nx = .Range(.[c7], .[c7].End(4)).Resize(, 14).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(nx)
    If nx(i, 12) = Sheet3.[n3] Then
        If Not dic.exists(nx(i, 3)) Then
            dic.Add nx(i, 3), nx(i, 9)
            tong = tong + nx(i, 9)
        Else
            dic.Item(nx(i, 3)) = dic.Item(nx(i, 3)) + nx(i, 9)
            tong = tong + nx(i, 9)
        End If
    End If
Next

If dic.Count Then
Application.ScreenUpdating = False
With Sheet3
    .[a9:c1000].ClearContents
    .[a9].Resize(dic.Count) = "=row()-8"
    .[a9].Resize(dic.Count).Value = [a9].Resize(dic.Count).Value
    .[b9].Resize(dic.Count).Value = Application.Transpose(dic.keys)
    .[C9].Resize(dic.Count).Value = Application.Transpose(dic.items)
    .[b9].End(4).Offset(1).Value = "Tong"
    .[C9].End(4).Offset(1).Value = tong
End With
Application.ScreenUpdating = True
End If

End Sub

Bữa ở topic kia bác có nói không dùng mãng tạm............mò hoài chưa ra. hôm nay gặp bài này của bác........đúng là không cần mãng tạm mà Chơi bằng Key + Item luôn.....

 

[doveandrose]

Sub BonjourVietNam()
Dim nx As Variant, dic As Object, i, tong As Long
With Sheets("NX")
    nx = .Range(.[c7], .[c7].End(4)).Resize(, 14).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(nx)
    If nx(i, 12) = Sheet3.[n3] Then
        If Not dic.exists(nx(i, 3)) Then
            dic.Add nx(i, 3), nx(i, 9)
            tong = tong + nx(i, 9)
        Else
            dic.Item(nx(i, 3)) = dic.Item(nx(i, 3)) + nx(i, 9)
            tong = tong + nx(i, 9)
        End If
    End If
Next

If dic.Count Then
Application.ScreenUpdating = False
With Sheet3
    .[a9:c1000].ClearContents
    .[a9].Resize(dic.Count) = "=row()-8"
    .[a9].Resize(dic.Count).Value = [a9].Resize(dic.Count).Value
    .[b9].Resize(dic.Count).Value = Application.Transpose(dic.keys)
    .[C9].Resize(dic.Count).Value = Application.Transpose(dic.items)
    .[b9].End(4).Offset(1).Value = "Tong"
    .[C9].End(4).Offset(1).Value = tong
End With
Application.ScreenUpdating = True
End If

End Sub

hồi trước Let's Gâu Gâu có hỏi hpKhuong là không dùng mảng tạm có được không ?
nhưng hpKhuong chưa đáp trả
giờ thì Let's Gâu Gâu biểu diễn rồi nè . thấy chưa hpKhuong ? hihi

 

[hpkhuong]

hồi trước Let's Gâu Gâu có hỏi hpKhuong là không dùng mảng tạm có được không ?
nhưng hpKhuong chưa đáp trả
giờ thì Let's Gâu Gâu biểu diễn rồi nè . thấy chưa hpKhuong ? hihi

Kaka.......thấy rồi..........thật mở mang tầm mắt!!!

 

[ndu96081631]

Bữa ở topic kia bác có nói không dùng mãng tạm............mò hoài chưa ra. hôm nay gặp bài này của bác........đúng là không cần mãng tạm mà Chơi bằng Key + Item luôn.....

Cũng chưa chắc cách nào hay hơn đâu!
Ít nhất dùng mảng tạm sẽ chắc ăn hơn Application.Transpose ở chỗ thằng Transpose sẽ bị lỗi (vô chừng) khi gặp dữ liệu lớn

 

[n0thing1988]

Cũng chưa chắc cách nào hay hơn đâu!
Ít nhất dùng mảng tạm sẽ chắc ăn hơn Application.Transpose ở chỗ thằng Transpose sẽ bị lỗi (vô chừng) khi gặp dữ liệu lớn

Thưa thầy với dữ liệu thật của em gồm hơn 3000 dòng thì đúng là mắc lỗi này ạ.
Mong thầy và các anh, chị tìm biện pháp giải quyết giúp em được ko ạ

 

[hpkhuong]

Thưa thầy với dữ liệu thật của em gồm hơn 3000 dòng thì đúng là mắc lỗi này ạ.
Mong thầy và các anh, chị tìm biện pháp giải quyết giúp em được ko ạ

Liên hệ tác giả gấp..................

 

[giangleloi]

Thưa thầy với dữ liệu thật của em gồm hơn 3000 dòng thì đúng là mắc lỗi này ạ.
Mong thầy và các anh, chị tìm biện pháp giải quyết giúp em được ko ạ

Thế thì lại nhờ hpkhuong đưa vô mảng tạm thôi, hehe.

 

[Let'GâuGâu]

Thưa thầy với dữ liệu thật của em gồm hơn 3000 dòng thì đúng là mắc lỗi này ạ.
Mong thầy và các anh, chị tìm biện pháp giải quyết giúp em được ko ạ

nó bị lổi gì vậy bạn
thật tình thì tôi chẳng bao giao làm với số liệu lớn như vậy..........hihihihi

Sub BonjourVietNam()
Dim nx, kq(1 To 6000, 1 To 3) As Variant, dic As Object, i, tong, k, j As Long
With Sheets("NX")
    nx = .Range(.[c7], .[c7].End(4)).Resize(, 14).Value
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(nx)
    If nx(i, 12) = Sheet3.[n3] Then
        If Not dic.exists(nx(i, 3)) Then
            k = k + 1
            dic.Add nx(i, 3), k
            kq(k, 1) = k
            kq(k, 2) = nx(i, 3)
            kq(k, 3) = nx(i, 9)
            tong = tong + nx(i, 9)
        Else
           j = dic.Item(nx(i, 3))
           kq(j, 3) = kq(j, 3) + nx(i, 9)
           tong = tong + nx(i, 9)
        End If
    End If
Next

If k Then
Application.ScreenUpdating = False
With Sheet3
    .[a9:c1000].ClearContents
    .[a9].Resize(k, 3) = kq
    .[b9].End(4).Offset(1).Value = "Tong"
    .[C9].End(4).Offset(1).Value = tong
End With
Application.ScreenUpdating = True
End If

End Sub