Viết code cho file tách công

[nguyentheviet86]

Thân gửi anh chị !
Nhờ anh chị giúp đỡ
1.Tại sheet "Công Thực tế" tại cột H và I là giờ IN và OUT thực tế
2. Tại Sheet " OVT" là bảng công đã được quy đổi ra số phút, Tại cột D : là ca ngày , N : là ca đêm. Tức là mỗi 1 ID sẽ có 2 dòng, và khi cộng tổng từng ngày sẽ ra số phút ngày hôm đó tăng ca được mấy phút
3. Kết quả như mong muốn tại sheet " Công đã tách" dựa vào số phút của sheet " OVT " tính toán để lấy được số giờ OUT theo số phút đó, còn giờ IN thì vẫn lấy giờ thực tế tại sheet " Công thực tế " và có cách nào tạo ra số giây ở đuôi




Em cảm ơn anh chị !

 

[snow25]

Thân gửi anh chị !
Nhờ anh chị giúp đỡ
1.Tại sheet "Công Thực tế" tại cột H và I là giờ IN và OUT thực tế
2. Tại Sheet " OVT" là bảng công đã được quy đổi ra số phút, Tại cột D : là ca ngày , N : là ca đêm. Tức là mỗi 1 ID sẽ có 2 dòng, và khi cộng tổng từng ngày sẽ ra số phút ngày hôm đó tăng ca được mấy phút
3. Kết quả như mong muốn tại sheet " Công đã tách" dựa vào số phút của sheet " OVT " tính toán để lấy được số giờ OUT theo số phút đó, còn giờ IN thì vẫn lấy giờ thực tế tại sheet " Công thực tế " và có cách nào tạo ra số giây ở đuôi

View attachment 277449

View attachment 277450
Em cảm ơn anh chị !

Thử code này.Còn số giây bạn vào chỉnh trong format là được mà.

Sub hensui()
    Dim i As Long, lr As Long, dic As Object, arr, kq, b As Long, j As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A7:AI" & lr).Value
         For i = 3 To UBound(arr) Step 2
             For j = 6 To 35
                 dk = arr(i, 1) & "#" & CLng(arr(1, j))
                 If arr(i, j) > 0 Or arr(i + 1, j) > 0 Then
                    dic.Item(dk) = (arr(i, j) + arr(i + 1, j)) / 1440
                 End If
             Next j
         Next i
    End With
    With Sheet2
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("B2:I" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 8)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & "#" & CLng(arr(i, 1))
             If dic.exists(dk) Then
                kq(i, 8) = arr(i, 8) - dic.Item(dk)
             Else
                kq(i, 8) = arr(i, 8)
             End If
             For j = 1 To 7
                 kq(i, j) = arr(i, j)
             Next j
          Next i
    End With
    With Sheet3
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr > 1 Then .Range("B2:I" & lr).ClearContents
         .Range("B2:I2").Resize(i - 1).Value = kq
    End With
    Set dic = Nothing
End Sub

 

[nguyentheviet86]

Thử code này.Còn số giây bạn vào chỉnh trong format là được mà.

Sub hensui()
    Dim i As Long, lr As Long, dic As Object, arr, kq, b As Long, j As Long, dk As String
    Set dic = CreateObject("scripting.dictionary")
    With Sheet1
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A7:AI" & lr).Value
         For i = 3 To UBound(arr) Step 2
             For j = 6 To 35
                 dk = arr(i, 1) & "#" & CLng(arr(1, j))
                 If arr(i, j) > 0 Or arr(i + 1, j) > 0 Then
                    dic.Item(dk) = (arr(i, j) + arr(i + 1, j)) / 1440
                 End If
             Next j
         Next i
    End With
    With Sheet2
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("B2:I" & lr).Value
         ReDim kq(1 To UBound(arr), 1 To 8)
         For i = 1 To UBound(arr)
             dk = arr(i, 2) & "#" & CLng(arr(i, 1))
             If dic.exists(dk) Then
                kq(i, 8) = arr(i, 8) - dic.Item(dk)
             Else
                kq(i, 8) = arr(i, 8)
             End If
             For j = 1 To 7
                 kq(i, j) = arr(i, j)
             Next j
          Next i
    End With
    With Sheet3
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         If lr > 1 Then .Range("B2:I" & lr).ClearContents
         .Range("B2:I2").Resize(i - 1).Value = kq
    End With
    Set dic = Nothing
End Sub

Anh điều chỉnh giúp em 1 chút được không ạ, Những ngày tại sheet " OVT" là khoảng trắng hoặc 0 thì sheet " Công đã tách" mặc định giờ out là 17:00, còn những ngày nào có số phút thì số giờ công tách cũng phải bằng số phút đó ạ. Em cảm ơn ạ !