Code liệt kê và tính tổng khối lượng sản phẩm?

[ultimatum86]

Xin chào các Anh/chị GPE,
Do chủ đề kia vi phạm nội quy nên mình tạo chủ đề mới, mong anh/chị Mod thông cảm.
Mình xin gửi lên 2 tập tin: 1 file là form của mình, và 1 file lúc trước được anh/chị Ba tê giúp đỡ viết code. Mong Anh/chị xem giúp và giúp đỡ mình phần code như sau:

1- Button Tinh toan: Khi mình ấn vào button này bên sheet Thong tin thì nó sẽ tính tổng khối lượng sản phẩm và tính tổng giá theo những mục đã quy định tại cột W và X( giống như công thức mình đang tính hiện tại vậy đó). Ngoài việc tính tổng sản phẩm nó sẽ liệt kê các nhãn hiệu vào cột B bên sheet Thong tin loại trừ 1 số nhãn hiệu do mình yêu cầu( giống như file của Anh/chị Ba Tê viết giúp trước đây).
2- Button Loại bỏ: Khi mình nhập 1 nhãn hiệu nào đó vào List( D3846 sheet thong tin), ở đây mình nhập ví dụ là ABB, khi ấn button loại bỏ nó sẽ kiểm tra cột F bên sheet CV, Những dòng nào có chữ ABB thì giá tại cột P = giá cột O - giá cột L tương ứng. (Vì không thể Copy và paste Special value trong chế độ filter nên phải dùng tới cách này).

Mong anh/chị xem và giúp đỡ.

 

[Ba Tê]

Xin chào các Anh/chị GPE,
Do chủ đề kia vi phạm nội quy nên mình tạo chủ đề mới, mong anh/chị Mod thông cảm.
Mình xin gửi lên 2 tập tin: 1 file là form của mình, và 1 file lúc trước được anh/chị Ba tê giúp đỡ viết code. Mong Anh/chị xem giúp và giúp đỡ mình phần code như sau:

1- Button Tinh toan: Khi mình ấn vào button này bên sheet Thong tin thì nó sẽ tính tổng khối lượng sản phẩm và tính tổng giá theo những mục đã quy định tại cột W và X( giống như công thức mình đang tính hiện tại vậy đó). Ngoài việc tính tổng sản phẩm nó sẽ liệt kê các nhãn hiệu vào cột B bên sheet Thong tin loại trừ 1 số nhãn hiệu do mình yêu cầu( giống như file của Anh/chị Ba Tê viết giúp trước đây).
2- Button Loại bỏ: Khi mình nhập 1 nhãn hiệu nào đó vào List( D3846 sheet thong tin), ở đây mình nhập ví dụ là ABB, khi ấn button loại bỏ nó sẽ kiểm tra cột F bên sheet CV, Những dòng nào có chữ ABB thì giá tại cột P = giá cột O - giá cột L tương ứng. (Vì không thể Copy và paste Special value trong chế độ filter nên phải dùng tới cách này).

Mong anh/chị xem và giúp đỡ.

Xem tiếp file này coi sao

 

[ultimatum86]

Xem tiếp file này coi sao

rất tuyệt vời anh Ba Tê ( vì không biết anh hay chị nên gọi đại là anh nha, không đúng thì nói lại để mình sửa nha, chị mà kêu anh thì mệt, ).

Nhưng cần sửa chút xíu là tại cột P nếu bấm nút Loại bỏ thì giá trị này Value chứ không còn công thức nữa, vì mình cần xóa giá trị của nó tại cột L mà.

Cảm ơn anh rất nhiều.

 

[Ba Tê]

rất tuyệt vời anh Ba Tê ( vì không biết anh hay chị nên gọi đại là anh nha, không đúng thì nói lại để mình sửa nha, chị mà kêu anh thì mệt, ).

Nhưng cần sửa chút xíu là tại cột P nếu bấm nút Loại bỏ thì giá trị này Value chứ không còn công thức nữa, vì mình cần xóa giá trị của nó tại cột L mà.

Cảm ơn anh rất nhiều.

Nếu vậy thì càng dễ, bạn dùng Sub này thay cho Sub cũ trong Module thử xem.
Sub này gán giá trị vào cột P (P=O-L) xong, xóa giá trị trong cột L.

Public Sub LoaiBo()
Dim Dic As Object, Rng As Range, Cll As Range
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Sheets("Thong tin").[D38:D46]
For Each Cll In Rng
    If Cll.Value <> vbNullString Then
        If Not Dic.exists(Cll.Value) Then Dic.Add Cll.Value, ""
    End If
Next
With Sheets("CV")
    Set Rng = .Range(.[F12], .[F65000].End(xlUp))
    For Each Cll In Rng
        If Cll.Offset(, 6) > 0 Then
            If Dic.exists(Cll.Value) Then
                Cll.Offset(, 10).Value = Cll.Offset(, 9).Value - Cll.Offset(, 6).Value  ''--Gan gia tri
                Cll.Offset(, 6).Value = vbNullString ''--------------------- Xoa cot L
            End If
        Else
            Cll.Offset(, 10).Value = vbNullString
        End If
    Next
End With
Set Dic = Nothing
Set Rng = Nothing
End Sub

 

[ultimatum86]

Nếu vậy thì càng dễ, bạn dùng Sub này thay cho Sub cũ trong Module thử xem.
Sub này gán giá trị vào cột P (P=O-L) xong, xóa giá trị trong cột L.

Public Sub LoaiBo()
Dim Dic As Object, Rng As Range, Cll As Range
Set Dic = CreateObject("Scripting.Dictionary")
Set Rng = Sheets("Thong tin").[D38:D46]
For Each Cll In Rng
    If Cll.Value <> vbNullString Then
        If Not Dic.exists(Cll.Value) Then Dic.Add Cll.Value, ""
    End If
Next
With Sheets("CV")
    Set Rng = .Range(.[F12], .[F65000].End(xlUp))
    For Each Cll In Rng
        If Cll.Offset(, 6) > 0 Then
            If Dic.exists(Cll.Value) Then
                Cll.Offset(, 10).Value = Cll.Offset(, 9).Value - Cll.Offset(, 6).Value  ''--Gan gia tri
                Cll.Offset(, 6).Value = vbNullString ''--------------------- Xoa cot L
            End If
        Else
            Cll.Offset(, 10).Value = vbNullString
        End If
    Next
End With
Set Dic = Nothing
Set Rng = Nothing
End Sub

File chạy ok rồi đó anh, cảm ơn anh Ba Tê rất nhiều.
Mình có thêm cái Listbox và textbox vào nữa, Nhưng mà sao trong file gốc thì khi liệt kê ra listbox không có dấu gạch dưới, còn khi mình copy cái code đó qua file này thì lại có dấu gạch dưới. Nhờ anh Ba Tê xem giúp với. Anh xem giúp code vậy có được chưa nha, vì file còn nhiều công thức khác nên làm sao chạy nhanh là được.