Nhờ vả viết code thống kê dạng pivottable

[tronghoabg]

- anh chị nào viết giúp em code thống kê với, em viết nhưng ko chạy dc



file đính kèm đây ạ:
https://1drv.ms/x/s!ApDjppKkfXsOhTt-5sCUPM22ZNz0
em cám ơn ạ

Sub loc_ten_hang()
Dim er As Long
    er = Range("B" & Rows.Count).End(xlUp).Row
    
    Range("I2:I50").ClearContents
    Range("i2") = Range("b2")
For i = 3 To er
er2 = Range("I" & Rows.Count).End(xlUp).Row
    For j = 2 To er2
    If Range("b" & i) <> Range("i" & j) Then
    Range("i" & i) = Range("b" & i)
    Else
    End If
    
Next
Next
End Sub
Sub vitri_sl_tong()

End Sub

 

[tronghoabg]

có ai không giúp em với ạ

 

[tronghoabg]

Chán

 

[ThangCuAnh]

Uhm, mình cũng chán theo luôn

 

[Lê Hồng Minh83]

View attachment 220106


- anh chị nào viết giúp em code thống kê với, em viết nhưng ko chạy dc

View attachment 220109

file đính kèm đây ạ:
https://1drv.ms/x/s!ApDjppKkfXsOhTt-5sCUPM22ZNz0
em cám ơn ạ

Sub loc_ten_hang()
Dim er As Long
    er = Range("B" & Rows.Count).End(xlUp).Row
   
    Range("I2:I50").ClearContents
    Range("i2") = Range("b2")
For i = 3 To er
er2 = Range("I" & Rows.Count).End(xlUp).Row
    For j = 2 To er2
    If Range("b" & i) <> Range("i" & j) Then
    Range("i" & i) = Range("b" & i)
    Else
    End If
   
Next
Next
End Sub
Sub vitri_sl_tong()

End Sub

Mình cũng không có nhiều thời gian, nên mới chỉ giúp bạn được câu 1 thôi, tham khảo nhé

Sub loc()
    Dim i As Long, j As Long, dic As Object, lr As Long, arr(), rarr(1 To 1000, 1 To 1), dk As String
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        lr = .Range("A1000").End(xlUp).Row
        arr = .Range("A2:D" & lr).Value
        For i = 1 To UBound(arr, 1)
            dk = arr(i, 2)
            If Not dic.exists(dk) Then
            dic.Add dk, ""
            j = j + 1
            rarr(j, 1) = dk
            End If
        Next
        .Range("I2:I" & lr).ClearContents
        .Range("I2").Resize(j) = rarr
    End With
    Set dic = Nothing
End Sub

Tham khảo file đính kèm