Chuyển dữ liệu sang hàng ngang

[Bích Tỷ]

Chào Anh/Chị

Em có 1 file giờ công ở sheet "Data", em cần chuyển nó sang sheet "BAOCAO" theo hàng ngang theo ngày và theo tên, giờ công của ngày sẽ là tổng giờ công của sáng, chiều và tối, ngày nào có tổng giờ công là 0 thì sẽ hiển thị "OFF". cuối cùng là tính tổng giờ công của 1 tháng ạ. Nhờ anh/chị hỗ trợ em với ạ.

Em xin cảm ơn ạ

 

[HUONGHCKT]

Chào Anh/Chị

Em có 1 file giờ công ở sheet "Data", em cần chuyển nó sang sheet "BAOCAO" theo hàng ngang theo ngày và theo tên, giờ công của ngày sẽ là tổng giờ công của sáng, chiều và tối, ngày nào có tổng giờ công là 0 thì sẽ hiển thị "OFF". cuối cùng là tính tổng giờ công của 1 tháng ạ. Nhờ anh/chị hỗ trợ em với ạ.

Em xin cảm ơn ạ

Tham khảo code củ chuối sau trong khi chờ code sịn hơn.

Option Explicit

Sub BichTy()
Dim i&, j&, Lr&, t&, k&, R&, Time As Single, Col&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet

Set Sh = Sheets("data")
Lr = Sh.Cells(Rows.Count, 2).End(xlUp).Row
Arr = Sh.Range("B6:T" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To R / 31, 1 To 32)
ReDim Tong(1 To R / 31, 1 To 1)
For i = 1 To R
    Key = Arr(i, 1): Col = Day(Arr(i, 2)) + 1:
    Time = Arr(i, 17) + Arr(i, 18) + Arr(i, 19)
    
    If Not Dic.Exists(Key) Then
        t = t + 1: Dic.Add (Key), t
        KQ(t, 1) = Key
        If Time = 0 Then KQ(t, Col) = "OFF" Else KQ(t, Col) = Time
        Tong(t, 1) = Time
    Else
        k = Dic.Item(Key)
        If Time = 0 Then KQ(k, Col) = "OFF" Else KQ(k, Col) = Time
        Tong(k, 1) = Tong(k, 1) + Time
    End If
Next i
If t Then
    Set Ws = Sheets("baocao")
        Ws.Range("E5").Resize(t, 32) = KQ
        Ws.Range("AK5").Resize(t, 1) = Tong
End If
Set Dic = Nothing
MsgBox "Done"
End Sub

các vấn đề về định dạng bạn tự làm

 

[BuiQuangThuan]

Tham khảo code củ chuối sau trong khi chờ code sịn hơn.

Cứ là tự động thì cũng đã là OK rồi. Chú cứ bảo là code củ chuối nghe nó sao sao ấy.

 

[Bích Tỷ]

Tham khảo code củ chuối sau trong khi chờ code sịn hơn.

Option Explicit

Sub BichTy()
Dim i&, j&, Lr&, t&, k&, R&, Time As Single, Col&
Dim Arr(), KQ()
Dim Dic As Object, Key
Dim Sh As Worksheet, Ws As Worksheet

Set Sh = Sheets("data")
Lr = Sh.Cells(Rows.Count, 2).End(xlUp).Row
Arr = Sh.Range("B6:T" & Lr).Value
R = UBound(Arr)
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To R / 31, 1 To 32)
ReDim Tong(1 To R / 31, 1 To 1)
For i = 1 To R
    Key = Arr(i, 1): Col = Day(Arr(i, 2)) + 1:
    Time = Arr(i, 17) + Arr(i, 18) + Arr(i, 19)
   
    If Not Dic.Exists(Key) Then
        t = t + 1: Dic.Add (Key), t
        KQ(t, 1) = Key
        If Time = 0 Then KQ(t, Col) = "OFF" Else KQ(t, Col) = Time
        Tong(t, 1) = Time
    Else
        k = Dic.Item(Key)
        If Time = 0 Then KQ(k, Col) = "OFF" Else KQ(k, Col) = Time
        Tong(k, 1) = Tong(k, 1) + Time
    End If
Next i
If t Then
    Set Ws = Sheets("baocao")
        Ws.Range("E5").Resize(t, 32) = KQ
        Ws.Range("AK5").Resize(t, 1) = Tong
End If
Set Dic = Nothing
MsgBox "Done"
End Sub

các vấn đề về định dạng bạn tự làm

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