Giúp code Lọc tên hàng Nếu trùng Cộng dồn Số Lượng (1 người xem)

[minhtuan55]

Chào cả nhà GPE !
Em cần 1 đoạn code Lọc tên hàng và SL ra 1 bảng riêng, vì file của em tên hàng Trùng tên rất nhiều. Em muốn nếu Trùng Tên hàng thì Cộng dồn SL lại. Em có gửi File trong đính kèm

p/s: hiện tại em đang dùng hàm Sumif nên File Lưu rất chậm, Mong mọi người giúp đở. em xin chân thành cảm ơn !

 

[hoamattroicoi]

Chào cả nhà GPE !
Em cần 1 đoạn code Lọc tên hàng và SL ra 1 bảng riêng, vì file của em tên hàng Trùng tên rất nhiều. Em muốn nếu Trùng Tên hàng thì Cộng dồn SL lại. Em có gửi File trong đính kèm

p/s: hiện tại em đang dùng hàm Sumif nên File Lưu rất chậm, Mong mọi người giúp đở. em xin chân thành cảm ơn !

Bản chất của vấn đề vẫn là cộng dồn trong trường hợp trùng của 2 file của bạn gửi lên, bạn xem code dưới có chạy được không nhé.
Cảm ơn.

Sub LocTrung()
Dim i As Long, k As Long, t As Long
Dim sArr(), dArr()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("B4:C" & Sheet1.[C65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr), 1 To 2)
For i = 1 To UBound(sArr)
    If Not Dic.exists(sArr(i, 1)) Then
        k = k + 1
        Dic(sArr(i, 1)) = k
        dArr(k, 1) = sArr(i, 1): dArr(k, 2) = sArr(i, 2)
    Else
        t = Dic.Item(sArr(i, 1))
        dArr(t, 2) = dArr(t, 2) + sArr(i, 2)
    End If
Next
Sheet1.[F4].Resize(k, 2) = dArr
Set Dic = Nothing
End Sub

 

[minhtuan55]

Thank anh nhé. Code anh Quá tuyệt vời. Cho em hỏi thêm 1 cái nữa. Ví dụ File của em gồm 3 cột
Tên hàng Đơn giá SL

Tên hàng nằm cột A
Đơn giá nằm cột B ( cùng tên hàng thì đơn giá = nhau hết )
SL nằm cột C
thì mình thay đổi địa chỉ làm sao cho Phù hợp. Và hiện tại code của anh khi lọc ra nó cứ dư ra 1 con số 0 ở dòng cuối anh có thể Fix lỗi này nữa thì càng tốt

Bản chất của vấn đề vẫn là cộng dồn trong trường hợp trùng của 2 file của bạn gửi lên, bạn xem code dưới có chạy được không nhé.
Cảm ơn.

Sub LocTrung()
Dim i As Long, k As Long, t As Long
Dim sArr(), dArr()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("B4:C" & Sheet1.[C65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr), 1 To 2)
For i = 1 To UBound(sArr)
    If Not Dic.exists(sArr(i, 1)) Then
        k = k + 1
        Dic(sArr(i, 1)) = k
        dArr(k, 1) = sArr(i, 1): dArr(k, 2) = sArr(i, 2)
    Else
        t = Dic.Item(sArr(i, 1))
        dArr(t, 2) = dArr(t, 2) + sArr(i, 2)
    End If
Next
Sheet1.[F4].Resize(k, 2) = dArr
Set Dic = Nothing
End Sub

 

[SA_DQ]

Đó là chị, còn đây mới là anh nè:

Option Explicit
Sub LocTrung()
Dim I As Long, K As Long, T As Long
Dim sArr(), dArr(), Dic As Object

Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("A4:C" & Sheet1.[C3].End(xlDown).Row).Value '*'
ReDim dArr(1 To UBound(sArr), 1 To 3)                       '*'
For I = 1 To UBound(sArr)
    If Not Dic.exists(sArr(I, 1)) Then
        K = K + 1:                  Dic(sArr(I, 1)) = K
        dArr(K, 1) = sArr(I, 1):    dArr(K, 2) = sArr(I, 3) '*'
    Else
        T = Dic.Item(sArr(I, 1))
        dArr(T, 2) = dArr(T, 2) + sArr(I, 3)                '*'
    End If
Next
Sheet1.[F4].Resize(K, 2) = dArr
Set Dic = Nothing
End Sub

 

[minhtuan55]

[

QUOTE=HYen17;765934]

Option Explicit
Sub LocTrung()
Dim I As Long, K As Long, T As Long
Dim sArr(), dArr(), Dic As Object

Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("A4:C" & Sheet1.[C3].End(xlDown).Row).Value '*'
ReDim dArr(1 To UBound(sArr), 1 To 3)                       '*'
For I = 1 To UBound(sArr)
    If Not Dic.exists(sArr(I, 1)) Then
        K = K + 1:                  Dic(sArr(I, 1)) = K
        dArr(K, 1) = sArr(I, 1):    dArr(K, 2) = sArr(I, 3) '*'
    Else
        T = Dic.Item(sArr(I, 1))
        dArr(T, 2) = dArr(T, 2) + sArr(I, 3)                '*'
    End If
Next
Sheet1.[F4].Resize(K, 2) = dArr
Set Dic = Nothing
End Sub

[/QUOTE]

Thank anh. Em muốn lấy luôn cột đơn giá qua bảng Ouput F4 luôn anh. Anh sửa lại code giúp em. Trùng tên hàng đơn gia luôn luôn bằng nhau

 

[SA_DQ]

Sửa macro với 19 dòng lệnh như sau:

Muốn vậy, trước tiên cần sửa thiết kế trang tính; Mà cụ thể là thêm cột đơn giá tại cột [G:G]

Sau đó là:

D11: Sửa con số cuối (3) thành 2;

Dưới ngay dòng này ta thêm dòng lệnh:

 [COLOR=#000000][COLOR=#007700][/COLOR][COLOR=#0000BB]dArr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]K[/COLOR][COLOR=#007700], [/COLOR]3[COLOR=#007700]) = [/COLOR][COLOR=#0000BB]sArr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]I[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]3[/COLOR][COLOR=#007700]) [/COLOR][COLOR=#DD0000]'*'

[/COLOR][/COLOR]

D15 (cũ) Hễ nới nào có con 2 thì sửa thành 3

D17: (Sửa giống D15)

Chúc thành công.

 

[minhtuan55]

Muốn vậy, trước tiên cần sửa thiết kế trang tính; Mà cụ thể là thêm cột đơn giá tại cột [G:G]

Sau đó là:

D11: Sửa con số cuối (3) thành 2;

Dưới ngay dòng này ta thêm dòng lệnh:

 [COLOR=#000000][COLOR=#007700][/COLOR][COLOR=#0000BB]dArr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]K[/COLOR][COLOR=#007700], [/COLOR]3[COLOR=#007700]) = [/COLOR][COLOR=#0000BB]sArr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]I[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]3[/COLOR][COLOR=#007700]) [/COLOR][COLOR=#DD0000]'*'

[/COLOR][/COLOR]

D15 (cũ) Hễ nới nào có con 2 thì sửa thành 3

D17: (Sửa giống D15)

Chúc thành công.

cháu cảm ơn chú nhiều lắm. Bữa nào rảnh cháu xuống Q5 alo bác . Cháu còn vấn đề Chống mở File 2 lần không biết khi nào chú Giúp