Giúp code cộng dồn số lượng, đơn giá, thành tiền tứ 1 vùng chuỗi dữ liệu (1 người xem)

[minhtuan55]

Chào cả nhà GPE !
Chúc cả nhà 1 ngày làm việc vui vẽ
em cần cả nhà giúp em 1 đoạn code để em cộng dồn được số lượng, đơn giá, thành tiền lại với nhau nếu trùng tên mặt hàng. Chi tiết em có ghi rõ trong File . mong mọi người giúp mình. mình xin chân thành cảm ơn !

 

[Ba Tê]

Chào cả nhà GPE !
Chúc cả nhà 1 ngày làm việc vui vẽ
em cần cả nhà giúp em 1 đoạn code để em cộng dồn được số lượng, đơn giá, thành tiền lại với nhau nếu trùng tên mặt hàng. Chi tiết em có ghi rõ trong File . mong mọi người giúp mình. mình xin chân thành cảm ơn !

Công thức cho ô E13:

=Lubulonxon($B$4:$B$5,$D13,COLUMNS($A:A))

Hàm tự tạo cho file này:

Public Function LuBuLonXon(Rng As Range, Ma As String, N As Long) As Double
Dim Cll As Range, J As Long, Tmp, Tem
For Each Cll In Rng
    Tmp = Split(Cll.Value, ";")
    For J = 0 To UBound(Tmp)
        If InStr(UCase(Tmp(J)), UCase(Ma)) Then
            Tem = Split(Tmp(J), "*")
            If N = 1 Then
                LuBuLonXon = LuBuLonXon + Tem(1)
            ElseIf N = 2 Then
                LuBuLonXon = LuBuLonXon + Tem(2)
            Else
                LuBuLonXon = LuBuLonXon + Tem(3)
            End If
        End If
    Next J
Next Cll
End Function

Máy bạn trong Control Panel phải đặt dấu phân cách số lẻ là dấu "CHẤM" như dữ liệu trong cột B

 

[minhtuan55]

Em cảm ơn anh nhiều lắm, Code của anh chưa đúng ý em. Mong anh sửa lại giúp em:

1. trong file dữ liệu đầu ra em ghi sẳn là Coca, pessi, sting em ghi để cho mọi người đọc hiểu ý của em muốn gì. Em muốn khi click vào nút bấm thì Tên hàng, Tổng Sl, Tổng Đơn giá, Tổng Thành tiền ra luôn
( hiện tại code của anh em phải tự nhập ra tên hàng rồi mới áp dụng công thức )

2. Em đã thử em nhập 1 tên hàng không có trong chuỗi dữ liệu mà công thức vẫn hiểu > 0 ( Ví dụ nhập tên hàng là "a" thì SL, Đơn giá, Thành tiền nhẽ ra phải =0 mà công thức của anh là 1 con số gì gì đó em chẳng hiểu )

3. Đã dùng code thì anh cho kết quả xuất ra luôn, em không muốn dùng công thức vì nó làm tăng dung lượng file và Save chậm. Hiện tai File công ty của em đang dữ liệu như thế này. em đang đau đầu mỗi khi tính toán. mong anh giúp em

Anh có thể tham khảo đoạn code của anh ndu96081631 ở đây . Code của anh ndu96081631 Xuất ra thì ok nhưng chưa cộng dồn lại được
https://www.giaiphapexcel.com/forum...Giúp-sửa-code-lọc-1-chuỗi-sang-1-bảng-dữ-liệu

Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As LongPrivate Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Sub ClearClipboard()
    OpenClipboard (0&)
    EmptyClipboard
    CloseClipboard
End Sub
Private Sub Transpose2Table(ByVal RangeSource As Range, ByVal Target As Range)
  Dim sTmp As String, objClb As Object
  RangeSource.Copy
  Set objClb = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
  objClb.GetFromClipboard
  sTmp = objClb.GetText
  If Len(sTmp) > 2 Then
    sTmp = Replace(sTmp, "*", vbTab)
    sTmp = Replace(sTmp, ";", vbCrLf)
    sTmp = Replace(sTmp, vbCrLf & vbCrLf, vbCrLf)
    objClb.Clear
    objClb.SetText sTmp
    objClb.PutInClipboard
    Target.PasteSpecial
    ClearClipboard
  End If
End Sub
Sub Main()
  Transpose2Table Range("b4:b20"), Range("D13")   ' b4:b20  dau vao  ;  D13 dau ra
End Sub

Công thức cho ô E13:

=Lubulonxon($B$4:$B$5,$D13,COLUMNS($A:A))

Hàm tự tạo cho file này:

Public Function LuBuLonXon(Rng As Range, Ma As String, N As Long) As Double
Dim Cll As Range, J As Long, Tmp, Tem
For Each Cll In Rng
    Tmp = Split(Cll.Value, ";")
    For J = 0 To UBound(Tmp)
        If InStr(UCase(Tmp(J)), UCase(Ma)) Then
            Tem = Split(Tmp(J), "*")
            If N = 1 Then
                LuBuLonXon = LuBuLonXon + Tem(1)
            ElseIf N = 2 Then
                LuBuLonXon = LuBuLonXon + Tem(2)
            Else
                LuBuLonXon = LuBuLonXon + Tem(3)
            End If
        End If
    Next J
Next Cll
End Function

Máy bạn trong Control Panel phải đặt dấu phân cách số lẻ là dấu "CHẤM" như dữ liệu trong cột B

 

[VetMini]

Tổng đơn giá ??????

 

[Ba Tê]

Em cảm ơn anh nhiều lắm, Code của anh chưa đúng ý em. Mong anh sửa lại giúp em:

1. trong file dữ liệu đầu ra em ghi sẳn là Coca, pessi, sting em ghi để cho mọi người đọc hiểu ý của em muốn gì. Em muốn khi click vào nút bấm thì Tên hàng, Tổng Sl, Tổng Đơn giá, Tổng Thành tiền ra luôn
( hiện tại code của anh em phải tự nhập ra tên hàng rồi mới áp dụng công thức )

2. Em đã thử em nhập 1 tên hàng không có trong chuỗi dữ liệu mà công thức vẫn hiểu > 0 ( Ví dụ nhập tên hàng là "a" thì SL, Đơn giá, Thành tiền nhẽ ra phải =0 mà công thức của anh là 1 con số gì gì đó em chẳng hiểu )

3. Đã dùng code thì anh cho kết quả xuất ra luôn, em không muốn dùng công thức vì nó làm tăng dung lượng file và Save chậm. Hiện tai File công ty của em đang dữ liệu như thế này. em đang đau đầu mỗi khi tính toán. mong anh giúp em

Đâu biết bạn muốn "bấm nút".
Bấm cái này thử xem.

Public Sub LuBu()
Dim sArr(), dArr(), Tmp, Tem, MaHang As String, I As Long, J As Long, K As Long, R As Long
    sArr = Range("B3", Range("B3").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R * 10, 1 To 4)
With CreateObject("Scripting.Dictionary")
For I = 2 To R
    Tmp = Split(sArr(I, 1), ";")
    For J = 0 To UBound(Tmp)
        If Len(Tmp(J)) Then
            Tem = Split(Tmp(J), "*"): MaHang = UCase(Tem(0))
            If Not .Exists(MaHang) Then
                K = K + 1: .Add MaHang, K
                dArr(K, 1) = MaHang
            End If
            R = .Item(MaHang)
            dArr(R, 2) = dArr(R, 2) + Val(Tem(1))
            dArr(R, 3) = dArr(R, 3) + Val(Tem(2))
            dArr(R, 4) = dArr(R, 4) + Val(Tem(3))
        End If
    Next J
Next I
End With
Range("D13:G13").Resize(K) = dArr
End Sub

 

[Ba Tê]

Tổng đơn giá ??????

Tác giả yêu cầu sao thì làm vậy thôi mà.
Dữ liệu quái chiêu thì yêu cầu kết quả cũng quái chiêu.

 

[minhtuan55]

Cảm ơn anh nhiệt tình quá. Code anh đúng 98% rồi con 2 % a Fix xíu nữa là ok

1. Tên hàng nếu trùng tên mà khác CHỮ HOA chữ thường thì code của anh hiểu 2 tên hàng. Ví dụ BÁNH XÈO và bánh xèo
A sửa lại Code không quan trọng chữ hoa và chữ thường , nếu trùng tên mà khác CHỮ HOA chữ thường thì hiểu 1 tên hàng thôi

2. Khi trong bảng dữ liệu không có gì hết thì Code a bị lỗi. khi không có gì hết thì không xuất ra gì hết

Đâu biết bạn muốn "bấm nút".
Bấm cái này thử xem.

Public Sub LuBu()
Dim sArr(), dArr(), Tmp, Tem, MaHang As String, I As Long, J As Long, K As Long, R As Long
    sArr = Range("B3", Range("B3").End(xlDown)).Value
    R = UBound(sArr)
    ReDim dArr(1 To R * 10, 1 To 4)
With CreateObject("Scripting.Dictionary")
For I = 2 To R
    Tmp = Split(sArr(I, 1), ";")
    For J = 0 To UBound(Tmp)
        If Len(Tmp(J)) Then
            Tem = Split(Tmp(J), "*"): MaHang = UCase(Tem(0))
            If Not .Exists(MaHang) Then
                K = K + 1: .Add MaHang, K
                dArr(K, 1) = MaHang
            End If
            R = .Item(MaHang)
            dArr(R, 2) = dArr(R, 2) + Val(Tem(1))
            dArr(R, 3) = dArr(R, 3) + Val(Tem(2))
            dArr(R, 4) = dArr(R, 4) + Val(Tem(3))
        End If
    Next J
Next I
End With
Range("D13:G13").Resize(K) = dArr
End Sub

 

[VetMini]

Cảm ơn anh nhiệt tình quá. Code anh đúng 98% rồi con 2 % a Fix xíu nữa là ok

1. Tên hàng nếu trùng tên mà khác CHỮ HOA chữ thường thì code của anh hiểu 2 tên hàng. Ví dụ BÁNH XÈO và bánh bèo
A sửa lại Code không quan trọng chữ hoa và chữ thường , nếu trùng tên mà khác CHỮ HOA chữ thường thì hiểu 1 tên hàng thôi

2. Khi trong bảng dữ liệu không có gì hết thì Code a bị lỗi. khi không có gì hết thì không xuất ra gì hết

BÁNH XÈO mà muốn giống bánh bèo thì gọi là 2% sao được? ít nhất là 95%

 

[minhtuan55]

BÁNH XÈO mà muốn giống bánh bèo thì gọi là 2% sao được? ít nhất là 95%

Sorry em ghi nhầm BÁNH XÈO và bánh xèo

 

[Ba Tê]

Sorry em ghi nhầm BÁNH XÈO và bánh xèo

Code bài #6 không phân biệt chữ HOA hay thường!
Nếu:
- Không có dữ liệu cũng bấm chạy code? "Siêng quá đi!"
- Dữ liệu cách quãng không liên tục? "Mệt quá đi!"
- Dữ liệu không đúng dạng "Tên hàng*SoLuong*DonGia*Thanhtien", dấu cách không phải "CHẤM PHẨY"? "Lu bu quá đi!"
- Số lẻ lúc thì "4.5" lúc thì "4,5". "Lộn Xộn quá đi"
Đã xử lý được 1 vài cái "Nếu":

Public Sub LuBu()
Dim sArr(), dArr(), Tmp, Tem, MaHang As String, I As Long, J As Long, K As Long, R As Long, Rws As Long
Range("D13:G100").ClearContents
R = Range("B65536").End(xlUp).Row
If R = 3 Then
    MsgBox "Dien Qua Di!!!!!! Co Du lieu Dau Ma Cung Chay Code", , "So Qua Di !!!"
    Exit Sub
End If
    sArr = Range("B3:B" & R).Value
    R = UBound(sArr): ReDim dArr(1 To R * 10, 1 To 4)
With CreateObject("Scripting.Dictionary")
For I = 2 To R
    If Len(sArr(I, 1)) Then
        Tmp = Split(sArr(I, 1), ";")
        For J = 0 To UBound(Tmp)
            If Len(Tmp(J)) Then
                Tem = Split(Tmp(J), "*"): MaHang = UCase(Tem(0))
                If Not .Exists(MaHang) Then
                    K = K + 1: .Add MaHang, K
                    dArr(K, 1) = MaHang
                End If
                Rws = .Item(MaHang)
                dArr(Rws, 2) = dArr(Rws, 2) + Val(Tem(1))
                dArr(Rws, 3) = dArr(Rws, 3) + Val(Tem(2))
                dArr(Rws, 4) = dArr(Rws, 4) + Val(Tem(3))
            End If
        Next J
    End If
Next I
End With
Range("D13:G13").Resize(K) = dArr
End Sub