Tổng hợp và tính tổng theo điều kiện

Tien Long · 24/11/22

Xin chào tất cả mọi người,
Tôi đã tạo dữ liệu mẫu như này, và có làm công thức nhưng do dữ liệu tương đối nhiều nên nhờ mọi người hỗ trợ code VBA,
với yêu cầu là:
B1:Nhập vào điều kiện Model ở ô A2. (Chỉ cần nhập1 điều kiện ở ô A2 thì sẽ hiển thị tất cả dữ liệu)
B2: Lấy danh sách ngày từ sheet data theo điều kiện ở ô A2 điền vào 2 dòng cột B gồm ( đơn sản xuất và đơn bù).
B3: Tính tổng số lượng của đơn sản xuất theo size, model (Ô A2), trong cột D ở sheet data không chứa ký tự PT.
B4: Tính tổng số lượng của đơn sản xuất theo size,model (Ô A2), trong cột D ở sheet data có chứa ký tự PT.

Xin cảm ơn mọi người đã hỗ trợ.

snow25 · 24/11/22

Tien Long đã viết:
Xin chào tất cả mọi người,
Tôi đã tạo dữ liệu mẫu như này, và có làm công thức nhưng do dữ liệu tương đối nhiều nên nhờ mọi người hỗ trợ code VBA,
với yêu cầu là:
B1:Nhập vào điều kiện Model ở ô A2. (Chỉ cần nhập1 điều kiện ở ô A2 thì sẽ hiển thị tất cả dữ liệu)
B2: Lấy danh sách ngày từ sheet data theo điều kiện ở ô A2 điền vào 2 dòng cột B gồm ( đơn sản xuất và đơn bù).
B3: Tính tổng số lượng của đơn sản xuất theo size, model (Ô A2), trong cột D ở sheet data không chứa ký tự PT.
B4: Tính tổng số lượng của đơn sản xuất theo size,model (Ô A2), trong cột D ở sheet data có chứa ký tự PT.

Xin cảm ơn mọi người đã hỗ trợ.

Cột B có sẵn hay là phải thêm vào.Mà trái phải là sao.

Tien Long · 24/11/22

snow25 đã viết:
Cột B có sẵn hay là phải thêm vào.Mà trái phải là sao.

Cột B là lấy từ sheet data qua luôn á bạn không phải nhập tay. trái phải có nghĩa là 1 đôi giày gồm 2 chiếc trái phải, ở sheet data thể hiện là 1 đôi, nhưng qua sheet report sẽ thể hiện chiếc nên có 2 cột chiếc trái phải á bạn

Tien Long · 25/11/22

snow25 đã viết:
Cột B có sẵn hay là phải thêm vào.Mà trái phải là sao.

Bạn hỗ trợ giúp mình vấn đề này với, cảm ơn bạn.

bebo021999 · 25/11/22

Tại sheet REPORT, bạn nhập mã model tại ô A2 thì kết quả sẽ cập nhật nhé.
Click chuột phải vào tên sheet/View Code, dán đoạn code vào:

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, j&, k&, rng, res(), id As String
Dim dic As Object, dic2 As Object, key
Set dic = CreateObject("Scripting.Dictionary"): Set dic2 = CreateObject("Scripting.Dictionary")
If Target.Address(0, 0) <> "A2" Then Exit Sub
ReDim res(1 To 100000, 1 To 3)
With Sheets("data")
    lr = .Cells(Rows.Count, "E").End(xlUp).Row
    rng = .Range("C2:AC" & lr).Value2
    For i = 2 To UBound(rng)
        If rng(i, 3) = Target.Value Then
            If Not dic2.exists(rng(i, 1)) Then
                dic2.Add rng(i, 1), ""
                k = k + 1
                res(k, 1) = Int((k - 1) / 2) + 1: res(k, 2) = rng(i, 1): res(k, 3) = "don san xuat"
                k = k + 1
                res(k, 2) = rng(i, 1): res(k, 3) = "don bu"
            End If
            For j = 4 To UBound(rng, 2)
                id = rng(i, 1) & "|" & IIf(InStr(1, rng(i, 2), "PT"), "BU", "SX") & "|" & rng(1, j)
                Debug.Print lr, id
                If Not dic.exists(id) Then
                    dic.Add id, rng(i, j)
                Else
                    dic(id) = dic(id) + rng(i, j)
                End If
            Next
        End If
    Next
End With
With Sheets("REPORT")
    .Range("A4:BB10000").ClearContents
    On Error Resume Next
    .Range("A4").Resize(k, 1).UnMerge
    .Range("A4").Resize(k, 3).Value = res
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("G2:BB" & lr).Value
    For i = 3 To UBound(rng)
        For j = 1 To UBound(rng, 2)
            id = res(i - 2, 2) & "|" & IIf(res(i - 2, 1) = "", "BU", "SX") & "|" & rng(1, j)
            For Each key In dic.keys
                If id = key Then rng(i, j) = dic(key)
            Next
        Next
    Next
    .Range("G2").Resize(UBound(rng), UBound(rng, 2)).Value = rng
    For i = 4 To lr Step 2
        .Cells(i, 1).Resize(2, 1).Merge
    Next
End With
Set dic = Nothing: Set dic2 = Nothing
End Sub

BuiQuangThuan · 25/11/22

Thêm cách khác tham khảo

Mã:

Option Explicit
Sub TongHop()
    Dim Dic As Object, sArr(), Res(), Key, i&, Model$, iRow&
    Dim S, K&, J&, m&, STT&, sC&
    Set Dic = CreateObject("scripting.dictionary")
    Model = Sheets("REPORT").Range("A2").Value
    With Sheets("Data")
        iRow = .Range("E" & Rows.Count).End(3).Row
        sArr = .Range("A2:AC" & iRow).Value
        sC = (UBound(sArr, 2) - 5) * 2 + 6
    End With
    ReDim Res(1 To UBound(sArr), 1 To sC)
    For i = 2 To UBound(sArr)
        If sArr(i, 5) = Model Then
            Key = Model & "|" & sArr(i, 3)
            Dic(Key) = Dic(Key) & "," & i
        End If
    Next
    For Each Key In Dic.keys
        K = K + 2: STT = STT + 1''
        S = Split(Dic(Key), ",")
        Res(K - 1, 1) = STT
        Res(K - 1, 2) = Split(Key, "|")(1)
        Res(K, 2) = Split(Key, "|")(1)
        Res(K - 1, 3) = "Don san xuat"
        Res(K, 3) = "Don bu"
        For J = 6 To UBound(sArr, 2)
            m = m + 1
            For i = 1 To UBound(S)
                If Not sArr(--S(i), 4) Like "*PT*" Then
                    Res(K - 1, J + m) = Res(K - 1, J + m) + sArr(--S(i), J)
                    Res(K - 1, J + m + 1) = Res(K - 1, J + m)
                Else
                    Res(K, J + m) = Res(K, J + m) + sArr(--S(i), J)
                    Res(K, J + m + 1) = Res(K, J + m)
                End If
            Next
        Next
    Next
    With Sheets("REPORT")
        .Range("A4").Resize(1000, sC).Clear
        .Range("A4").Resize(Dic.Count * 2, sC).Value = Res
        .Range("A4").Resize(Dic.Count * 2, sC).Borders.LineStyle = 1
    End With
End Sub

Tien Long · 30/11/22

bebo021999 đã viết:

Tại sheet REPORT, bạn nhập mã model tại ô A2 thì kết quả sẽ cập nhật nhé.
Click chuột phải vào tên sheet/View Code, dán đoạn code vào:

PHP:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, j&, k&, rng, res(), id As String
Dim dic As Object, dic2 As Object, key
Set dic = CreateObject("Scripting.Dictionary"): Set dic2 = CreateObject("Scripting.Dictionary")
If Target.Address(0, 0) <> "A2" Then Exit Sub
ReDim res(1 To 100000, 1 To 3)
With Sheets("data")
    lr = .Cells(Rows.Count, "E").End(xlUp).Row
    rng = .Range("C2:AC" & lr).Value2
    For i = 2 To UBound(rng)
        If rng(i, 3) = Target.Value Then
            If Not dic2.exists(rng(i, 1)) Then
                dic2.Add rng(i, 1), ""
                k = k + 1
                res(k, 1) = Int((k - 1) / 2) + 1: res(k, 2) = rng(i, 1): res(k, 3) = "don san xuat"
                k = k + 1
                res(k, 2) = rng(i, 1): res(k, 3) = "don bu"
            End If
            For j = 4 To UBound(rng, 2)
                id = rng(i, 1) & "|" & IIf(InStr(1, rng(i, 2), "PT"), "BU", "SX") & "|" & rng(1, j)
                Debug.Print lr, id
                If Not dic.exists(id) Then
                    dic.Add id, rng(i, j)
                Else
                    dic(id) = dic(id) + rng(i, j)
                End If
            Next
        End If
    Next
End With
With Sheets("REPORT")
    .Range("A4:BB10000").ClearContents
    On Error Resume Next
    .Range("A4").Resize(k, 1).UnMerge
    .Range("A4").Resize(k, 3).Value = res
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("G2:BB" & lr).Value
    For i = 3 To UBound(rng)
        For j = 1 To UBound(rng, 2)
            id = res(i - 2, 2) & "|" & IIf(res(i - 2, 1) = "", "BU", "SX") & "|" & rng(1, j)
            For Each key In dic.keys
                If id = key Then rng(i, j) = dic(key)
            Next
        Next
    Next
    .Range("G2").Resize(UBound(rng), UBound(rng, 2)).Value = rng
    For i = 4 To lr Step 2
        .Cells(i, 1).Resize(2, 1).Merge
    Next
End With
Set dic = Nothing: Set dic2 = Nothing
End Sub

cảm ơn anh rất nhiều

Bài đã được tự động gộp: 30/11/22

BuiQuangThuan đã viết:

Thêm cách khác tham khảo

Mã:

Option Explicit
Sub TongHop()
    Dim Dic As Object, sArr(), Res(), Key, i&, Model$, iRow&
    Dim S, K&, J&, m&, STT&, sC&
    Set Dic = CreateObject("scripting.dictionary")
    Model = Sheets("REPORT").Range("A2").Value
    With Sheets("Data")
        iRow = .Range("E" & Rows.Count).End(3).Row
        sArr = .Range("A2:AC" & iRow).Value
        sC = (UBound(sArr, 2) - 5) * 2 + 6
    End With
    ReDim Res(1 To UBound(sArr), 1 To sC)
    For i = 2 To UBound(sArr)
        If sArr(i, 5) = Model Then
            Key = Model & "|" & sArr(i, 3)
            Dic(Key) = Dic(Key) & "," & i
        End If
    Next
    For Each Key In Dic.keys
        K = K + 2: STT = STT + 1''
        S = Split(Dic(Key), ",")
        Res(K - 1, 1) = STT
        Res(K - 1, 2) = Split(Key, "|")(1)
        Res(K, 2) = Split(Key, "|")(1)
        Res(K - 1, 3) = "Don san xuat"
        Res(K, 3) = "Don bu"
        For J = 6 To UBound(sArr, 2)
            m = m + 1
            For i = 1 To UBound(S)
                If Not sArr(--S(i), 4) Like "*PT*" Then
                    Res(K - 1, J + m) = Res(K - 1, J + m) + sArr(--S(i), J)
                    Res(K - 1, J + m + 1) = Res(K - 1, J + m)
                Else
                    Res(K, J + m) = Res(K, J + m) + sArr(--S(i), J)
                    Res(K, J + m + 1) = Res(K, J + m)
                End If
            Next
        Next
    Next
    With Sheets("REPORT")
        .Range("A4").Resize(1000, sC).Clear
        .Range("A4").Resize(Dic.Count * 2, sC).Value = Res
        .Range("A4").Resize(Dic.Count * 2, sC).Borders.LineStyle = 1
    End With
End Sub

cảm ơn bạn rất nhiều.

Tổng hợp và tính tổng theo điều kiện

Tien Long

Thành viên mới

File đính kèm

snow25

Thành viên gạo cội

Tien Long

Thành viên mới

Tien Long

Thành viên mới

bebo021999

Thành viên gạo cội

File đính kèm

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Tien Long

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng