Tính chi phí dựa theo nhiều điều kiện

AnhThu-1976 · 11/9/19

Các Anh/chị Giúp em bài toán tổng hợp sau
Sheet Data là dữ liệu ban đầu
Sheet KQ là kết quả em mong muốn chữ màu xanh
Đây là một bài thực tế ở công ty em
Em cảm ơn!

snow25 · 11/9/19

AnhThu-1976 đã viết:
Các Anh/chị Giúp em bài toán tổng hợp sau
Sheet Data là dữ liệu ban đầu
Sheet KQ là kết quả em mong muốn chữ màu xanh
Đây là một bài thực tế ở công ty em
Em cảm ơn!

Dùng dictionary là được nhé bạn.

AnhThu-1976 · 11/9/19

snow25 đã viết:
Dùng dictionary là được nhé bạn.

Hì biết là dùng dic được, nhưng vì Dic của mình đang ở căn bản, mà bài này tổng hợp theo cả tiêu đề cột và dòng nên chưa biết thuật toán làm sao
Bạn có thể viết code mẫu để mình học tập được không
Nói thêm: thực tế Lô hàng rất nhiều có thể lên 100 lô hàng, nên mình chưa biết xử lý sao ...

VetMini · 11/9/19

Cái này nếu xếp lại dữ liệu đàng hoàng thì dùng Pivot Table chứ đâu cần cốt kiếc đít điếc gì.

AnhThu-1976 · 11/9/19

VetMini đã viết:
Cái này nếu xếp lại dữ liệu đàng hoàng thì dùng Pivot Table chứ đâu cần cốt kiếc đít điếc gì.

Bài toán có nhiều phương án giải, nhưng vì em đang học code nên muốn giải bằng code
Như nói ở trên code Dic của em ở căn bản mà bài này tổng hợp theo hàng và cột và cột có thể phát sinh thêm nên em muốn học các anh/chị trên diễn đàn làm như thế nào để em học đó mà

VetMini · 11/9/19

Kinh nghiệm ở diễn đàn này cho biết, khi một người hỏi bài thì người ta đã hướng đầu óc của mình vào cái chỗ đó rồi; không có cách nào lay chuyển được.
Vì vậy, khi tôi nói Pivot Table, tôi không hề có ý mách bảo cho bạn bởi vì trình độ của bạn thừa biết cách này.
Ỏ đây, tôi nói chung cho những bạn khác hiểu hơn về sự liên hệ giữa Flat Table và Cross-Tab Table.

Chú: từ cốt kiếc đít điếc tôi dùng ở bài #4 với mục đích nói rằng "code VBA là đồ chơi, công cụ sẵn có của Excel mới là đồ thật"

snow25 · 11/9/19

VetMini đã viết:
Kinh nghiệm ở diễn đàn này cho biết, khi một người hỏi bài thì người ta đã hướng đầu óc của mình vào cái chỗ đó rồi; không có cách nào lay chuyển được.
Vì vậy, khi tôi nói Pivot Table, tôi không hề có ý mách bảo cho bạn bởi vì trình độ của bạn thừa biết cách này.
Ỏ đây, tôi nói chung cho những bạn khác hiểu hơn về sự liên hệ giữa Flat Table và Cross-Tab Table.

Anh ơi vì đây là cách sắp xếp dữ liệu của công ty bao đời nay rồi thay đổi khó lắm.Thay đổi mấy ông xếp nhìn thấy không hợp cho nghỉ việc thì chết.

VetMini · 11/9/19

snow25 đã viết:
Anh ơi vì đây là cách sắp xếp dữ liệu của công ty bao đời nay rồi thay đổi khó lắm.Thay đổi mấy ông xếp nhìn thấy không hợp cho nghỉ việc thì chết.

Tôi không tin một người có trình độ như bạn lại sợ nói chuyện với sếp về vấn đề này.
Nếu thật sự tôi lầm (tức là bạn sợ thật) thì lời chân thật tôi khuyên bạn là nên bớt thời gian vọc Excel để đi học kỹ năng trình bày với sếp.

Chú: tôi nói về "trình độ" của một người nhìn vào cái bảng dữ liệu kia mà hiểu được là nó có nhiều cách giải quyết.

snow25 · 11/9/19

VetMini đã viết:
Tôi không tin một người có trình độ như bạn lại sợ nói chuyện với sếp về vấn đề này.
Nếu thật sự tôi lầm (tức là bạn sợ thật) thì lời chân thật tôi khuyên bạn là nên bớt thời gian vọc Excel để đi học kỹ năng trình bày với sếp.

Chú: tôi nói về "trình độ" của một người nhìn vào cái bảng dữ liệu kia mà hiểu được là nó có nhiều cách giải quyết.

Không phải đâu anh.Vì nếu là em thì em đã viết luôn cho mình 1 cái data chuẩn với nhập liệu chuẩn rồi.Còn báo cáo thì lấy từ đó ra.

VetMini · 11/9/19

snow25 đã viết:
Không phải đâu anh.Vì nếu là em thì em đã viết luôn cho mình 1 cái data chuẩn với nhập liệu chuẩn rồi.Còn báo cáo thì lấy từ đó ra.

Nếu tôi là bạn thì tôi tìm thử xem có cách nào dùng Power Query để chuẩn lại cái bảng dữ liệu kia.
Có thể hơi khó, nhưng nếu không thử thì đời nào mới học. Ở bài #6 tôi đã nói "công cụ sẵn có của Excel mới là đồ thật"

snow25 · 11/9/19

AnhThu-1976 đã viết:
Các Anh/chị Giúp em bài toán tổng hợp sau
Sheet Data là dữ liệu ban đầu
Sheet KQ là kết quả em mong muốn chữ màu xanh
Đây là một bài thực tế ở công ty em
Em cảm ơn!

Bạn thử.Nhưng chưa chuẩn lắm tự bạn sửa tiếp nhé.

Mã:

Sub tinhtong()
    Dim arr, i As Long, dk As String, lr As String, dic As Object, j As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        arr = .Range("A3:D20").Value
    End With
        For i = 2 To UBound(arr)
            If arr(i, 2) <> Empty Then
               dk = arr(i, 1) & arr(i, 2) & arr(1, 2)
            Else
               dk = arr(i, 1) & arr(i, 3) & arr(1, 3)
            End If
            If Not dic.exists(dk) Then
               dic.Add dk, arr(i, 4)
            Else
               dic.Item(dk) = dic.Item(dk) + arr(i, 4)
            End If
        Next i
   With Sheets("kq")
        .Range("b5:i11").ClearContents
         arr = .Range("A3:I11").Value
     For j = 2 To UBound(arr, 2)
         If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
        For i = 3 To UBound(arr)
            dk = arr(1, j) & arr(i, 1) & arr(2, j)
            arr(i, j) = dic.Item(dk)
        Next i
     Next j
     .Range("A3:I11").Value = arr
  End With
End Sub

AnhThu-1976 · 12/9/19

Cảm ơn bạn nhiều lắm
Anh /chị có thêm cách nào thì cho em thêm để tham khảo ạ!

Lê Hồng Minh83 · 12/9/19

snow25 đã viết:
If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)

Dòng này hình như không để làm gì thì phải

snow25 · 12/9/19

Lê Hồng Minh83 đã viết:
Dòng này hình như không để làm gì thì phải

Có mà bạn.Trong dữ liệu đưa lên thì nó có ô không có dữ liệu nên cần phải thêm dòng này.Nhưng nếu chạy code 1 lần rồi thì nó sẽ điền đầy đủ vào nên không cần nữa.

Lê Hồng Minh83 · 12/9/19

snow25 đã viết:
Có mà bạn.Trong dữ liệu đưa lên thì nó có ô không có dữ liệu nên cần phải thêm dòng này.Nhưng nếu chạy code 1 lần rồi thì nó sẽ điền đầy đủ vào nên không cần nữa.

À, do mình không để ý dữ liệu thiếu trong sheet KQ, bạn đã lấp đầy dữ liệu thiếu bằng dòng code đó rồi

AnhThu-1976 · 13/9/19

snow25 đã viết:

Bạn thử.Nhưng chưa chuẩn lắm tự bạn sửa tiếp nhé.

Mã:

Sub tinhtong()
    Dim arr, i As Long, dk As String, lr As String, dic As Object, j As Long
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        arr = .Range("A3:D20").Value
    End With
        For i = 2 To UBound(arr)
            If arr(i, 2) <> Empty Then
               dk = arr(i, 1) & arr(i, 2) & arr(1, 2)
            Else
               dk = arr(i, 1) & arr(i, 3) & arr(1, 3)
            End If
            If Not dic.exists(dk) Then
               dic.Add dk, arr(i, 4)
            Else
               dic.Item(dk) = dic.Item(dk) + arr(i, 4)
            End If
        Next i
   With Sheets("kq")
        .Range("b5:i11").ClearContents
         arr = .Range("A3:I11").Value
     For j = 2 To UBound(arr, 2)
         If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
        For i = 3 To UBound(arr)
            dk = arr(1, j) & arr(i, 1) & arr(2, j)
            arr(i, j) = dic.Item(dk)
        Next i
     Next j
     .Range("A3:I11").Value = arr
  End With
End Sub

Dựa bài toán trên , em đã lấp đầy cột B và C của sheet Data = các ký tự khác
Em viết code lại nhưng không cho kết quả đúng
Nhờ các anh/chị xem giúp
Code em đã sửa lại

Mã:

Sub tinhtong1()
    Dim arr, i As Long, dk As String, lr As String, dic As Object, j As Long
    Dim arrT, d As Long    ' thêm
    Dim arrTT, n As Long

    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        arrT = .Range("A3", .Range("A65000").End(3)).Resize(, 4).Value
    End With
    arrTT = Range([A5], [A65000].End(3)).Value
    For n = 1 To UBound(arrTT)
        For d = 2 To UBound(arrT)

            
            If arrT(d, 2) = arrTT(n, 1) Then
                dk = arrT(d, 1) & arrTT(n, 1) & arrT(1, 2)
            End If

            If arrT(d, 3) = arrTT(n, 1) Then
                dk = arrT(d, 1) & arrTT(n, 1) & arrT(1, 3)
            End If
            
            If Not dic.exists(dk) Then
                dic.Add dk, arrT(d, 4)
            Else
                dic.Item(dk) = dic.Item(dk) + arrT(d, 4)
            End If
        Next
    Next
    With Sheets("kq")
        .Range("b5:k11").ClearContents
        arr = .Range("A3:k11").Value
        For j = 2 To UBound(arr, 2)
            'If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
            For i = 3 To UBound(arr)
                dk = arr(1, j) & arr(i, 1) & arr(2, j)
                arr(i, j) = dic.Item(dk)
            Next i
        Next j
        .Range("A3:k11").Value = arr
        'Range("A3").Resize(i - 1, j - 1).Value = arr
    End With
End Sub

Em cảm ơn!

Lê Hồng Minh83 · 13/9/19

AnhThu-1976 đã viết:

Dựa bài toán trên , em đã lấp đầy cột B và C của sheet Data = các ký tự khác
Em viết code lại nhưng không cho kết quả đúng
Nhờ các anh/chị xem giúp
Code em đã sửa lại

Mã:

Sub tinhtong1()
    Dim arr, i As Long, dk As String, lr As String, dic As Object, j As Long
    Dim arrT, d As Long    ' thêm
    Dim arrTT, n As Long

    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        arrT = .Range("A3", .Range("A65000").End(3)).Resize(, 4).Value
    End With
    arrTT = Range([A5], [A65000].End(3)).Value
    For n = 1 To UBound(arrTT)
        For d = 2 To UBound(arrT)

          
            If arrT(d, 2) = arrTT(n, 1) Then
                dk = arrT(d, 1) & arrTT(n, 1) & arrT(1, 2)
            End If

            If arrT(d, 3) = arrTT(n, 1) Then
                dk = arrT(d, 1) & arrTT(n, 1) & arrT(1, 3)
            End If
          
            If Not dic.exists(dk) Then
                dic.Add dk, arrT(d, 4)
            Else
                dic.Item(dk) = dic.Item(dk) + arrT(d, 4)
            End If
        Next
    Next
    With Sheets("kq")
        .Range("b5:k11").ClearContents
        arr = .Range("A3:k11").Value
        For j = 2 To UBound(arr, 2)
            'If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
            For i = 3 To UBound(arr)
                dk = arr(1, j) & arr(i, 1) & arr(2, j)
                arr(i, j) = dic.Item(dk)
            Next i
        Next j
        .Range("A3:k11").Value = arr
        'Range("A3").Resize(i - 1, j - 1).Value = arr
    End With
End Sub

Em cảm ơn!

Bạn viết code nhìn khá là rối
Đang có sự nhầm lẫn giữa arrT và arrTT nên khúc này có vấn đề

Mã:

dk = arrT(d, 1) & arrTT(n, 1) & arrT(1, 2)

nếu không lầm thì arrT là sheet "Data" còn arrTT là sheet "KQ"
Chạy dictionary ở sheet "Data" với các điều kiện của sheet đó và đem kết quả dán vào sheet "KQ" với các điều kiện của sheet KQ nhé

AnhThu-1976 · 13/9/19

Lê Hồng Minh83 đã viết:
Đang có sự nhầm lẫn giữa arrT và arrTT nên khúc này có vấn đề

Mã:

dk = arrT(d, 1) & arrTT(n, 1) & arrT(1, 2)

nếu không lầm thì arrT là sheet "Data" còn arrTT là sheet "KQ"(1)
Chạy dictionary ở sheet "Data" với các điều kiện của sheet đó và đem kết quả dán vào sheet "KQ" với các điều kiện của sheet KQ nhé(2)

(1) đúng rồi
(2) Chưa hiểu lắm, nhờ bạn giải thích thêm, cảm ơn bạn

Lê Hồng Minh83 · 13/9/19

AnhThu-1976 đã viết:
(1) đúng rồi
(2) Chưa hiểu lắm, nhờ bạn giải thích thêm, cảm ơn bạn

Bạn tham khảo code này

Mã:

Sub tinhtong()
    Dim arr, i As Long, dk As String, dic As Object, j As Long, lr As Long, dk1 As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheets("data")
        lr = .Range("A10000").End(xlUp).Row
        arr = .Range("A3:D" & lr).Value
    End With
        For i = 2 To UBound(arr)
            dk = arr(i, 1) & arr(i, 2) & arr(1, 2)
            dk1 = arr(i, 1) & arr(i, 3) & arr(1, 3)
            If Not dic.exists(dk) Then
               dic.Add dk, arr(i, 4)
            Else
               dic.Item(dk) = dic.Item(dk) + arr(i, 4)
            End If
            If Not dic.exists(dk1) Then
               dic.Add dk1, arr(i, 4)
            Else
               dic.Item(dk1) = dic.Item(dk1) + arr(i, 4)
            End If
        Next i
   With Sheets("kq")
        lr = .Range("A10000").End(xlUp).Row
        .Range("B5:K" & lr).ClearContents
         arr = .Range("A3:K" & lr).Value
     For j = 2 To UBound(arr, 2)
         If arr(1, j) = Empty Then arr(1, j) = arr(1, j - 1)
        For i = 3 To UBound(arr)
            dk = arr(1, j) & arr(i, 1) & arr(2, j)
            arr(i, j) = dic.Item(dk)
        Next i
     Next j
     .Range("A3:K" & lr).Value = arr
  End With
End Sub

Với Dictionary, lúc bạn add key cho nó ở sheet "Data" có 2 loại, nên mình sử dụng dk và dk1, nhưng khi add vào Dic rồi thì nó được coi là key thôi
và khi chạy vòng lặp cho sheet "QK" thì trùng key nào nó lấy item đó ra gán vào kết quả.

AnhThu-1976 · 13/9/19

Cảm ơn bạn nhiều!

Tính chi phí dựa theo nhiều điều kiện

Thành viên tích cực

File đính kèm

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

Thành viên tích cực

Ăn cùng góc phố

Thành viên tích cực

Ăn cùng góc phố

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

Ăn cùng góc phố

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

Ăn cùng góc phố

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

Thành viên tích cực

Thành viên tiêu biểu

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

Thành viên tiêu biểu

Thành viên tích cực

File đính kèm

Thành viên tiêu biểu

Thành viên tích cực

Thành viên tiêu biểu

File đính kèm

Thành viên tích cực

Facebook

Group