Tính tổng theo dữ liệu từ nhiều sheet (3 người xem)

[BuiQuangThuan]

Gửi các thầy cô. Em có bài toán muốn nhờ các thầy cô giúp.

Hiện tại file đính kèm là phần thực tích xưởng nhập ( dòng số 10)

Mỗi 1 sheet là 1 ngày trong tháng

Em muốn dựa vào mã sản phẩm và line để tính tổng số lượng phần thực tế theo từng ngày (ngày được xác đinh theo tên của từng sheet)

Kết quả sẽ được trả vào 1 vùng A3:AF(n)của sheet “Tong hop” ạ
Em xin cám ơn

 

[leonguyenz]

Gửi các thầy cô. Em có bài toán muốn nhờ các thầy cô giúp.

Hiện tại file đính kèm là phần thực tích xưởng nhập ( dòng số 10)

Mỗi 1 sheet là 1 ngày trong tháng

Em muốn dựa vào mã sản phẩm và line để tính tổng số lượng phần thực tế theo từng ngày (ngày được xác đinh theo tên của từng sheet)

Kết quả sẽ được trả vào 1 vùng A3:AF(n)của sheet “Tong hop” ạ
Em xin cám ơn

Bạn xem file nhé.
Lưu ý khai báo mảng, dòng này tôi chưa xác định được cận dưới:
ReDim reArr(1 To 5000, 1 To 32)
Số 5000 bạn căn cứ vào 2 điều kiện: Line * Mã sản phẩm
Nếu Line * Mã sản phẩm > 5000 thì bị lỗi, nên sửa lại số nào gần đúng.

Sub TongHop()
Dim wS As Worksheet, RightC As String, dArr(), d As Integer
Dim sArr(), i As Integer, j As Integer, LTmp As String, reArr()
Dim Dic As Object, k As Integer, Tmp As String
ReDim reArr(1 To 5000, 1 To 32)
Set Dic = CreateObject("Scripting.Dictionary")
dArr = Sheets("Tonghop").Range("C2:AF2").Value
Sheets("Tonghop").Range("A3:AF65535").ClearContents
For Each wS In ThisWorkbook.Worksheets
    For d = 1 To UBound(dArr, 2)
        If wS.Name = dArr(1, d) Then
            RightC = wS.Range("IV8").End(xlToLeft).Address(0, 0)
            sArr = wS.Range("C7:" & RightC & 10).Resize(4).Value
            For i = 1 To UBound(sArr, 2)
                If sArr(2, i) <> "" Then
                    LTmp = IIf(sArr(1, i) <> "", sArr(1, i), LTmp)
                    Tmp = LTmp & " # " & sArr(2, i)
                    If Not Dic.Exists(Tmp) Then
                        k = k + 1
                        Dic.Add Tmp, k
                        reArr(k, 1) = LTmp
                        reArr(k, 2) = sArr(2, i)
                        reArr(k, d + 2) = sArr(4, i)
                    Else
                        reArr(Dic.Item(Tmp), d + 2) = reArr(Dic.Item(Tmp), d + 2) + sArr(4, i)
                    End If
                End If
            Next i
        End If
    Next d
Next
If k Then Sheets("Tonghop").Range("A3").Resize(k, 32) = reArr
Set Dic = Nothing
End Sub

 

[BuiQuangThuan]

Bạn xem file nhé.
Lưu ý khai báo mảng, dòng này tôi chưa xác định được cận dưới:
ReDim reArr(1 To 5000, 1 To 32)
Số 5000 bạn căn cứ vào 2 điều kiện: Line * Mã sản phẩm
Nếu Line * Mã sản phẩm > 5000 thì bị lỗi, nên sửa lại số nào gần đúng.

Sub TongHop()
Dim wS As Worksheet, RightC As String, dArr(), d As Integer
Dim sArr(), i As Integer, j As Integer, LTmp As String, reArr()
Dim Dic As Object, k As Integer, Tmp As String
ReDim reArr(1 To 5000, 1 To 32)
Set Dic = CreateObject("Scripting.Dictionary")
dArr = Sheets("Tonghop").Range("C2:AF2").Value
Sheets("Tonghop").Range("A3:AF65535").ClearContents
For Each wS In ThisWorkbook.Worksheets
    For d = 1 To UBound(dArr, 2)
        If wS.Name = dArr(1, d) Then
            RightC = wS.Range("IV8").End(xlToLeft).Address(0, 0)
            sArr = wS.Range("C7:" & RightC & 10).Resize(4).Value
            For i = 1 To UBound(sArr, 2)
                If sArr(2, i) <> "" Then
                    LTmp = IIf(sArr(1, i) <> "", sArr(1, i), LTmp)
                    Tmp = LTmp & " # " & sArr(2, i)
                    If Not Dic.Exists(Tmp) Then
                        k = k + 1
                        Dic.Add Tmp, k
                        reArr(k, 1) = LTmp
                        reArr(k, 2) = sArr(2, i)
                        reArr(k, d + 2) = sArr(4, i)
                    Else
                        reArr(Dic.Item(Tmp), d + 2) = reArr(Dic.Item(Tmp), d + 2) + sArr(4, i)
                    End If
                End If
            Next i
        End If
    Next d
Next
If k Then Sheets("Tonghop").Range("A3").Resize(k, 32) = reArr
Set Dic = Nothing
End Sub

cám ơn anh rất nhiều. để em test thử xem đúng không ạ

 

[leonguyenz]

cám ơn anh rất nhiều. để em test thử xem đúng không ạ

Tôi đã kiểm tra tổng số lượng thực tế nhập các sheet, kết quả trả về tương ứng.
Nhưng code và file bài #2 sẽ lấy thiếu dòng với trường hợp Line merge ô và Mã sản phẩm tương ứng đầu tiên bị rỗng.
Thay đổi vị trí: LTmp = IIf(sArr(1, i) <> "", sArr(1, i), LTmp)

            For i = 1 To UBound(sArr, 2)
                If sArr(2, i) <> "" Then
                    LTmp = IIf(sArr(1, i) <> "", sArr(1, i), LTmp)
                    Tmp = LTmp & " # " & sArr(2, i)

Thành:

            For i = 1 To UBound(sArr, 2)
                LTmp = IIf(sArr(1, i) <> "", sArr(1, i), LTmp)
                If sArr(2, i) <> "" Then
                    Tmp = LTmp & " # " & sArr(2, i)

 

[tieuthubuongbinh]

Tôi đã kiểm tra tổng số lượng thực tế nhập các sheet, kết quả trả về tương ứng.

Thầy có tâm quá thầy ơi hihi

 

[BuiQuangThuan]

cám ơn anh leonguyenz nhiều ạ.thấy kết quả đúng rồi ạ. em còn 1 câu hỏi này muốn nhờ anh 1 xíu nữa ạ. em còn 1 file tổng hợp đơn đặt hàng để tại desktop

Dòng 7 em filter

Cột A lọc lấy 2 và 9

Cột B lọc (Blanks)

Cột C trừ những đơn hàng có chứa “ SAM”

Sau đó em muốn copy vùng có dữ liệu (từ hàng 7 đến dòng cuối cùng có dữ liệu) những cột sau:

“C,G,I,J,K, L, M, U, X “

Sang 1 sheet mới của workbook mới tại desktop có tên “TongHop” tại ô A2.
Nhờ anh có thể viết cho em đoạn code được ko a (lý do làm việc này là do em ko sử dụng được Pivot table cho cái file em đính kèm)

 

[leonguyenz]

cám ơn anh leonguyenz nhiều ạ.thấy kết quả đúng rồi ạ. em còn 1 câu hỏi này muốn nhờ anh 1 xíu nữa ạ. em còn 1 file tổng hợp đơn đặt hàng để tại desktop

Dòng 7 em filter

Cột A lọc lấy 2 và 9

Cột B lọc (Blanks)

Cột C trừ những đơn hàng có chứa “ SAM”

Bạn mở Thread mới. (đừng nhờ 1 mình tôi nhe).
Luôn tiện hỏi: Cột B lọc bỏ Blanks hay lấy Blanks?

 

[BuiQuangThuan]

Bạn mở Thread mới. (đừng nhờ 1 mình tôi nhe).
Luôn tiện hỏi: Cột B lọc bỏ Blanks hay lấy Blanks?

lấy banks ạ

 

[tieuthubuongbinh]

Bạn mở Thread mới. (đừng nhờ 1 mình tôi nhe).
Luôn tiện hỏi: Cột B lọc bỏ Blanks hay lấy Blanks?

@buiquangthuan
Bác ấy nói bạn mở thớt mới để có nhiều người xem và giúp hơn.
Bạn nên tạo 1 thớt mới để đưa câu hỏi 2 vào tiêu đề, và có thể dẫn link bài này để các chuyên gia biết bạn đã xử lý xong vấn đề 1, đang vướng vấn đề 2.
Hoặc bác Leo sẽ giúp tiếp, hoặc sẽ có thành viên khác giúp. Nên bạn đừng tag tên bác ấy vào là vậy, để có nhiều thành viên giúp thì nhanh hơn.

 

[BuiQuangThuan]

@buiquangthuan
Bác ấy nói bạn mở thớt mới để có nhiều người xem và giúp hơn.
Bạn nên tạo 1 thớt mới để đưa câu hỏi 2 vào tiêu đề, và có thể dẫn link bài này để các chuyên gia biết bạn đã xử lý xong vấn đề 1, đang vướng vấn đề 2.
Hoặc bác Leo sẽ giúp tiếp, hoặc sẽ có thành viên khác giúp. Nên bạn đừng tag tên bác ấy vào là vậy, để có nhiều thành viên giúp thì nhanh hơn.

vâng. em sẽ rút kinh nghiêm vụ này ạ.