Giúp viết code chuyển dữ liệu từ dòng thành cột theo ngày

[cubinv]

Xin chào các Anh Chị và các Bạn,
Mình có nhu cầu viết code chuyển dữ liệu nhập từng ngày theo dòng thành bảng tổng hợp từng ngày theo cột (nội dung cụ thể mình diễn giải theo file đính kèm). Mình đã tìm các bài viết của diễn đàn trước đây nhưng chưa có code nào phù hợp, rất mong các Bạn giúp, cảm ơn mọi người rất nhiều!

 

[BuiQuangThuan]

Sheet Bao_Cao là kết quả mẫu đó ạ

 

[Hoàng Tuấn 868]

Xin chào các Anh Chị và các Bạn,
Mình có nhu cầu viết code chuyển dữ liệu nhập từng ngày theo dòng thành bảng tổng hợp từng ngày theo cột (nội dung cụ thể mình diễn giải theo file đính kèm). Mình đã tìm các bài viết của diễn đàn trước đây nhưng chưa có code nào phù hợp, rất mong các Bạn giúp, cảm ơn mọi người rất nhiều!

Bạn xem thử. . .

 

[SA_DQ]

Thêm 1 tham khảo @chủ bài đăng:

Sub BaoCaoSLTheoNgay()
 Dim Rws As Long, J As Long, W As Long, Ngay As Integer, Col As Integer
 Dim Arr()
 
 With Sheets("DuLieu2")
    Rws = .[b9876].End(xlUp).Row
    Arr() = .[A7].Resize(Rws, 6).Value
    ReDim aKQ(1 To Rws, 1 To 36)
    [A7].Resize(3 * Rws, 36).Value = ""
    For J = 1 To Rws
        W = W + 1:                      Ngay = Day(Arr(J, 6))
        For Col = 1 To 5
            aKQ(W, Col) = Arr(J, Col)
        Next Col
        aKQ(W, Ngay + 5) = Arr(J, 5)
    Next J
 End With
 [A7].Resize(W, 36).Value = aKQ()
 MsgBox "Yes"
End Sub

 

[TongDe]

Dợt lại Pivot cho thớt tham khảo...

 

[Hoàng Tuấn 868]

Dợt lại Pivot cho thớt tham khảo...

Hình như mong muốn không phải là lấy số lượng như trong file.

 

[cubinv]

Cảm ơn Anh @Hoàng Tuấn 868 code của Anh đã đúng nhu cầu của em..
Cảm ơn Anh @SA_DQ và Bạn @Tống Văn Đệ đã hỗ trợ, tuy nhiên nhu cầu của em muốn lấy dữ liệu bộ phận sản xuất chứ không phải lấy số lượng, em sẽ lưu lại code của Anh chắc chắn sau này sẽ sử dụng đến.
Một lần nữa cảm ơn các Anh và các Bạn rất nhiều!

 

[bebo021999]

Bạn xem thử.

Hình như thiếu điều kiện "Tháng"?

 

[Hoàng Tuấn 868]

Hình như thiếu điều kiện "Tháng"?

Trong dãy từ F5:AI5 có đủ cả ngày, tháng, năm nhưng chỉ để hiện số ngày thôi anh ạ.

 

[cubinv]

Hình như thiếu điều kiện "Tháng"?

Cản ơn Anh, em định dạng đủ ngày tháng năm nên em thấy code chạy đúng rồi Anh

 

[bebo021999]

Trong dãy từ F5:AI5 có đủ cả ngày, tháng, năm nhưng chỉ để hiện số ngày thôi anh ạ.

Trong code không thấy điều kiện ngày tháng?
Hiện tại ví dụ bên sheet Dulieu2 là nhật ký của riêng tháng 11/2022 thì đúng.
Nếu mình là người dùng file này, thì Dulieu2 sẽ ghi nhật ký liên tục từ tháng này qua tháng khác và năm khác.
Nếu thay tháng 11/2022 thành tháng 12/2022 và code này sẽ sai.

 

[BuiQuangThuan]

Xin chào các Anh Chị và các Bạn,
Mình có nhu cầu viết code chuyển dữ liệu nhập từng ngày theo dòng thành bảng tổng hợp từng ngày theo cột (nội dung cụ thể mình diễn giải theo file đính kèm). Mình đã tìm các bài viết của diễn đàn trước đây nhưng chưa có code nào phù hợp, rất mong các Bạn giúp, cảm ơn mọi người rất nhiều!

Gop vui thêm 1 cách khác tham khảo

Option Explicit
Sub ABC()
    Dim sArr(), Res(), i&, Dic As Object, Rng As Range, aData(), Key
    Set Dic = CreateObject("scripting.dictionary")
    Set Rng = Sheets("data").Range("A8:E44")
    aData = Rng.Value
    With Sheets("Dulieu2")
        sArr = .Range("A7:G" & .Range("B" & Rows.Count).End(3).Row).Value
    End With
    ReDim Res(1 To UBound(aData), 1 To 31)
    For i = 1 To UBound(aData)
        If aData(i, 2) <> Empty Then
            Dic(aData(i, 2)) = i
        End If
    Next
    For i = 1 To UBound(sArr)
        If Dic.exists(sArr(i, 2)) = True Then
            Res(Dic(sArr(i, 2)), Day(sArr(i, 6))) = sArr(i, 7)
        End If
    Next
    With Sheets("viet_code")
        Rng.Copy .Range("A7")
        .Range("F7").Resize(UBound(aData), 31).Value = Res
    End With
End Sub

 

[Hoàng Tuấn 868]

Trong code không thấy điều kiện ngày tháng?
Hiện tại ví dụ bên sheet Dulieu2 là nhật ký của riêng tháng 11/2022 thì đúng.
Nếu mình là người dùng file này, thì Dulieu2 sẽ ghi nhật ký liên tục từ tháng này qua tháng khác và năm khác.
Nếu thay tháng 11/2022 thành tháng 12/2022 và code này sẽ sai.

Điều kiện của em là so sánh hai ô có đủ cả ngày, tháng và năm đó anh.
Em thử thay tháng 11/2022 thành tháng 12/2022 thì chạy vẫn đúng anh ạ. (tức là nếu không đúng ngày tháng năm thì không nhận dữ liệu).

 

[bebo021999]

Điều kiện của em là so sánh hai ô có đủ cả ngày, tháng và năm đó anh.

Bạn thử test lại:
Sheet Dulieu2: Thay 1 vài dòng từ tháng 11 sang tháng 12
Bên sheet báo cáo, dòng 2, thay điều kiện là 12 và 2022
Dòng 5 từ 1/12/2022 đến 31/12/2022
KQ sẽ sai.

Cản ơn Anh, em định dạng đủ ngày tháng năm nên em thấy code chạy đúng rồi Anh

Nếu yêu cầu của bạn đã thỏa thì OK.
Nhưng thành thật khuyên bạn nên dùng file này cho nhiều tháng.
Bên sheet Dulieu sẽ nhập phát sinh theo ngày - tháng - năm, bên sheet báo cáo chỉ cần chọn điều kiện "tháng" và "năm" tại dòng 2 thì kết quả sẽ tự động.
Vì mình thấy bạn đã tách tháng và năm ra 2 ô riêng biệt nên có vẻ bạn dự định dùng nó để làm điều kiện của báo cáo.

 

[Hoàng Tuấn 868]

Bạn thử test lại:
Sheet Dulieu2: Thay 1 vài dòng từ tháng 11 sang tháng 12
Bên sheet báo cáo, dòng 2, thay điều kiện là 12 và 2022
Dòng 5 từ 1/12/2022 đến 31/12/2022
KQ sẽ sai.

Em vừa thử lại, thay tháng 12, năm 2022 tại cột ngày tháng bên sheet Dulieu2 và dòng 5 bên sheet viet_code thành 01/12/2022 đến 31/12/2022 thì vẫn đúng anh ạ.

 

[cubinv]

Nhưng thành thật khuyên bạn nên dùng file này cho nhiều tháng.
Bên sheet Dulieu sẽ nhập phát sinh theo ngày - tháng - năm, bên sheet báo cáo chỉ cần chọn điều kiện "tháng" và "năm" tại dòng 2 thì kết quả sẽ tự động.
Vì mình thấy bạn đã tách tháng và năm ra 2 ô riêng biệt nên có vẻ bạn dự định dùng nó để làm điều kiện của báo cáo.

Em cảm ơn Anh, Anh rất tinh ý, code của Anh @Hoàng Tuấn 868 và Bạn @BuiQuangThuan em thấy đã chạy đúng theo nhu cầu của em. Nếu Anh giúp em code có điều kiện tháng nữa thì tốt cho em quá.

 

[bebo021999]

Em cảm ơn Anh, Anh rất tinh ý, code của Anh @Hoàng Tuấn 868 và Bạn @BuiQuangThuan em thấy đã chạy đúng theo nhu cầu của em. Nếu Anh giúp em code có điều kiện tháng nữa thì tốt cho em quá.

Xem file đính kèm.
Sheet Dulieu có thể nhập ngày tháng bất kỳ.
Sheet bao cao, ngày tháng tại dòng 5 mình thêm công thức tự động lấy ngày tháng của tháng-năm tại dòng 2
Code mình để trong worksheet module, sự kiện worksheet_change của ô "Tháng" và "Năm" sheet báo cáo, chỉ cần thay đổi 2 ô này là code tự động chạy, không cần bấm nút.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr&, i&, j&, rng, id As String
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
If Intersect(Target, Union(Range("R2"), Range("U2"))) Is Nothing Then Exit Sub
Range("A7:AJ10000").ClearContents
With Sheets("data")
    lr = .Cells(Rows.Count, "A").End(xlUp).Row
    .Range("A8:E" & lr).Copy Sheets("bao_cao").Range("A7")
End With
With Sheets("dulieu2")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("B7:G" & lr).Value2
End With
For i = 1 To UBound(rng)
    id = rng(i, 1) & "|" & rng(i, 3) & "|" & rng(i, 5)
    If Not dic.exists(id) Then
        dic.Add id, rng(i, 6)
    Else
        dic(id) = dic(id) & "|" & rng(i, 6)
    End If
Next
With Sheets("bao_cao")
    lr = .Cells(Rows.Count, "B").End(xlUp).Row
    rng = .Range("B7:AJ" & lr).Value2
    For i = 1 To UBound(rng)
        If rng(i, 1) <> "" Then
            For j = 5 To UBound(rng, 2)
                id = rng(i, 1) & "|" & rng(i, 3) & "|" & .Cells(5, j + 1).Value2
                For Each key In dic.keys
                    If id = key Then
                        rng(i, j) = dic(key)
                        Exit For
                    End If
                Next
            Next
        End If
    Next
    .Range("B7").Resize(UBound(rng), UBound(rng, 2)).Value = rng
End With
End Sub

 

[cubinv]

Xem file đính kèm.
Sheet Dulieu có thể nhập ngày tháng bất kỳ.
Sheet bao cao, ngày tháng tại dòng 5 mình thêm công thức tự động lấy ngày tháng của tháng-năm tại dòng 2
Code mình để trong worksheet module, sự kiện worksheet_change của ô "Tháng" và "Năm" sheet báo cáo, chỉ cần thay đổi 2 ô này là code tự động chạy, không cần bấm nút.

File và code hoàn hảo hơn em mong muốn, Em cảm ơn Anh @bebo021999 rất nhiều!