问题描述
格子里有日期和进出工厂的时间。我想计算每个人在他们来到工厂的那一天停留了多少小时。
为此，我编写了一个宏并将每个人定义为 sicil_no，因为它是一个唯一编号。但是由于在同一日期的不同时间有多个进入和退出，我需要编写一个宏代码来计算每个日期和 sicil_no（人）首先计算进入次数并存在然后减去然后添加它们以查找在工厂花费的总时间。
这就是我尝试做但做不到的方式。我在问题的末尾附上了一个简短的原始数据示例和一张图片。提前致谢
GECIS TARIHI SICIL NUMaraSI SoyaDI ADI GEÇİŞ YÖNÜ
04 03 2021 07:06:25 02491 约翰 CAN 条目
04 03 2021 09:28:01 02312 PLAT 7 月条目
04 03 2021 15:50:22 02312 PLAT 七月出口
04 03 2021 17:08:48 02491 JOHN CAN 退出
08 03 2021 07:06:45 02312 PLAT 7 月条目
08 03 2021 07:53:37 02260 BABER YOKY 条目
08 03 2021 13:05:38 02312 PLAT 七月出口
08 03 2021 13:18:30 02312 PLAT 7 月条目
08 03 2021 17:23:01 02312 PLAT 七月出口
08 03 2021 19:37:36 02260 BABER YOKY 退出
Sub macro()
Dim sicil_no As String
Dim i As Integer
Dim end_row As Long
Dim dates As Range
Dim gecis_yonu As String
Dim entry As String
Dim Exits As String
end_row = Cells(Rows.Count,3).End(xlUp).Row
For i = 3 To end_row
sicil_no = Cells(i,3).Value
dates = Cells(i,1).Value
If Range("J",i).Value = "Exit" Then
Range("J",i).Value = exist
End If
If Range("J",i).Value = "Entry" Then
Range("J",i).Value = entry
End If
Next
For Each dates In Range("A",end_row)
Range("M",i).Value = exist - entry
Next
解决方法
根据需要配置列和工作表名称。
Option Explicit
Sub CalcHours()
' configuration
Const COL_DATETIME = "A"
Const COL_ID = "B"
Const COL_NAME = "C"
Const COL_INOUT = "D"
Const SHT_DATA = "Sheet1"
Const SHT_REPORT = "Sheet2"
Dim wb As Workbook,ws As Worksheet,rng As Range
Dim i As Long,iLastRow As Long,dt As Date
Dim person As clsPerson,ID As String,sInOut As String
Dim people As Object,key
Set people = CreateObject("Scripting.Dictionary")
' scan data
Set wb = ThisWorkbook
Set ws = wb.Sheets(SHT_DATA)
iLastRow = ws.Cells(Rows.Count,COL_ID).End(xlUp).Row
For i = 2 To iLastRow
ID = Trim(ws.Cells(i,COL_ID))
If people.exists(ID) Then
Set person = people(ID)
Else
Set person = New clsPerson
person.ID = ID
person.Name = ws.Cells(i,COL_NAME)
people.Add ID,person
End If
' string to date
dt = ParseDate(ws.Cells(i,COL_DATETIME),i)
If dt = 0 Then Exit Sub
sInOut = Trim(UCase(ws.Cells(i,COL_INOUT))) ' entry/exit
If sInOut = "ENTRY" Then
person.ClockIn dt
ElseIf sInOut = "EXIT" Then
person.ClockOut dt
Else
MsgBox "ERROR Entry/Exit = " & sInOut,vbCritical,"Row " & i
End If
Next
' report results
Set ws = wb.Sheets(SHT_REPORT)
ws.Cells.Clear
ws.Range("A1:G1") = Array("ID","Name","Date","Total Hours","Entry","Exit","Hours")
Set rng = ws.Range("A2")
For Each key In people.keys
people(key).timesheet rng
Next
ws.Columns("A:G").AutoFit
ws.Activate
rng.Select
MsgBox " See report on " & ws.Name,vbInformation,"Count = " & people.Count
End Sub
Function ParseDate(s As String,i As Long) As Date
Dim ar
If s Like "## ## #### ##:##:##" Then
ar = Split(Application.Trim(s)," ")
ParseDate = DateSerial(ar(2),ar(1),ar(0)) + CDate(ar(3))
Else
MsgBox "Can not parse " & s & " on Row " & i,"ParseDate()"
ParseDate = 0
Exit Function
End If
End Function
Class Module clsPerson
======================
Option Explicit
'clsPerson
Public ID As String
Public Name As String
Public Dates As New Collection
Public atWork As Boolean
' person clocks in
Public Sub ClockIn(dt As Date)
Dim msg As String
' check not already clocked in
If atWork Then
msg = "ERROR - Repeat Entry for " & Me.ID & " " & Me.Name & " On " & dt
MsgBox msg,"clsPerson"
End If
Me.atWork = True
Dim dtWork As Date,workday As clsWorkDay
Dim n As Integer,isNew As Boolean
dtWork = Int(dt)
n = Dates.Count
If n = 0 Then
isNew = True
Else
If Dates(n).day = dtWork Then
Set workday = Dates(n)
Else
isNew = True
End If
End If
If isNew Then
Set workday = New clsWorkDay
workday.day = dtWork
Me.Dates.Add workday,CStr(n + 1)
End If
workday.ClockIn dt
End Sub
' person clocks out
Public Sub ClockOut(dt As Date)
Dim msg As String
' check is clocked in
If Not atWork Then
msg = "ERROR - Repeat Exit for " & Me.ID & " " & Me.Name & " On " & dt
MsgBox msg,"clsPerson"
End If
Me.atWork = False
Dim dtWork As Date,workday As clsWorkDay,n As Integer
dtWork = Int(dt)
n = Dates.Count
If n = 0 Then
msg = "ERROR - No dates for " & Me.ID & " " & Me.Name
MsgBox msg,"clsPerson"
Else
Set workday = Dates(n)
workday.ClockOut dt
End If
End Sub
Public Sub timesheet(ByRef rng As Range)
Dim workday As clsWorkDay,shift As clsShift
rng.Offset(0,0) = Me.ID
rng.Offset(0,1) = Me.Name
For Each workday In Me.Dates
rng.Offset(0,2) = workday.day
rng.Offset(0,3) = Format(workday.HoursWorked,"0.00")
For Each shift In workday.shifts
rng.Offset(0,4) = shift.ClockIn
rng.Offset(0,5) = shift.ClockOut
rng.Offset(0,6) = Format(shift.HoursWorked,"0.00")
Set rng = rng.Offset(1)
Next
Next
End Sub
Class Module clsWorkDay
=======================
Option Explicit
' clsWorkDay
Public day As Date
Public HoursWorked As Single
Public shifts As New Collection
Public atWork As Boolean
Public Sub ClockIn(dt As Date)
Dim shift As clsShift,msg As String
If Me.atWork = True Then
msg = "ERROR - Repeat Entry " & dt
MsgBox msg,"clsWorkDay"
End If
Me.atWork = True
Set shift = New clsShift
shift.ClockIn = dt
shift.atWork = True
shifts.Add shift
End Sub
Public Sub ClockOut(dt As Date)
Dim shift As clsShift,msg As String,n As Integer
If Me.atWork = False Then
msg = "ERROR - Repeat Exit " & dt
MsgBox msg,"clsWorkDay"
End If
Me.atWork = False
' get last shift
n = shifts.Count
If n > 0 Then
Set shift = shifts(n)
shift.ClockOut = dt
shift.HoursWorked = DateDiff("s",shift.ClockIn,shift.ClockOut) / 3600
Me.HoursWorked = Me.HoursWorked + shift.HoursWorked
shift.atWork = False
Else
MsgBox "ERROR - No shift to Exit from at " & dt,"clsWorkDay"
End If
End Sub
Class Module clsShift
=====================
Option Explicit
' clsShift
Public ClockIn As Date
Public ClockOut As Date
Public HoursWorked As Single
Public atWork As Boolean