VBA处理文件框架代码 【第五部分（5.1.1）：具体业务处理代码】

本程序共分７个部分

【框架代码】 
１．处理流程

【框架代码】 
２．变量定义

【框架代码】 
３．具体处理

【框架代码】 
４．bat定义

【框架代码】 
５．Excel文件操作

　　　　　　　　　　└
５．１．具体业务流程（读取，写入文件）

    　　　　　　　　　　 └ ５．１．１．具体业务处理代码

６．目录结构，框架功能介绍

７．程序页面布局


创建成果物文件

'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
'*                                    　　　　　　　　　  *
'* Out対象の全員シート作成　　                            *
'* 作成日：2017/08/13                                     *
'* 作成者：sun      　　　　　　　　　                    *
'* 更新日：2017/08/13  　　　　　　　　                   *
'* 更新者：sun     　　　　　　　　　　                   *
'*                                                        *
'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
Public Sub createOutFileAllSheets(outWb As Workbook)

On Error GoTo errl

'★★★Operate Out ファイル step1　start★★★
outWb.Activate
outWb.Sheets("LIST").Select

Dim peopleName As String
Dim peopleNumber As String

For i = 3 To 100

outWb.Sheets("LIST").Select
peopleName = Cells(i, 3).Value
peopleNumber = Cells(i, 2).Value

If peopleName = Empty Then
Exit For
End If

Sheets("000").Copy After:=Sheets(2 + (i - 3))
Sheets("000 (2)").Name = peopleNumber
Sheets(peopleNumber).Select
Range("C3").Value = peopleName

'KEY:peopleName, Value:peopleNumber
peopleInfo.Add peopleName, peopleNumber

Next

Sheets("000").Select
ActiveWindow.SelectedSheets.Delete
'★★★Operate Out ファイル step1　end★★★

GoTo endok
errl:
'異常処理
ERROR_FLG = "1"
ERROR_INFO_LIST.Add ("関数「createOutFileAllSheets」で、エラー発生しました。")
ERROR_INFO_LIST.Add ("エラー詳細：" & Err.Number & " ： " & Err.Description)
endok:

End Sub

读取数据（IN）

'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
'*                                    　　　　　　　　　  *
'* Read IN 指紋情報取込　　　 　　　                      *
'* 作成日：2017/08/13                                     *
'* 作成者：sun      　　　　　　　　　                    *
'* 更新日：2017/08/13  　　　　　　　　                   *
'* 更新者：sun     　　　　　　　　　　                   *
'*                                                        *
'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
Public Sub setFingerprintInfoIntoDictionary(wks As Worksheet)

On Error GoTo errl

'人たち毎月の情報
Dim peopleStartTimeList(31) As String
Dim peopleEndTimeList(31) As String

'★★★Read　fingerprint INFO start★★★

For i = 0 To 31
peopleStartTimeList(i) = ""
peopleEndTimeList(i) = ""
Next

Dim peopleName As String
Dim peopleNumber As String

Dim lastTimePeopleName

Dim strDate
Dim lastTimeStrDate

lastTimeStrDate = ""
strDate = ""
lastTimePeopleName = ""
peopleName = ""

For i = 2 To 10000

'名前を取得する
peopleName = wks.Cells(i, 1).Value

If peopleName = Empty Then
'該当人の出勤、退勤情報を保存する========================================start
Dim varCurrentPeopleStartTimeList_lastOne(31)
Dim varCurrentPeopleEndTimeList_lastOne(31)
For j = 0 To 31
varCurrentPeopleStartTimeList_lastOne(j) = peopleStartTimeList(j)
varCurrentPeopleEndTimeList_lastOne(j) = peopleEndTimeList(j)
Next

fingerprintStartTimeInfo.Add lastTimePeopleName, varCurrentPeopleStartTimeList_lastOne
fingerprintEndTimeInfo.Add lastTimePeopleName, varCurrentPeopleEndTimeList_lastOne
'Erase peopleEndTimeList
For k = 0 To 31
peopleStartTimeList(k) = ""
peopleEndTimeList(k) = ""
Next
'該当人の出勤、退勤情報を保存する========================================end
Exit For
End If

'日付を取得する
strDate = wks.Cells(i, 3).Value

'日付によって、時間保存のindexを算出する
Dim strsDate() As String
strsDate = Split(strDate, "/")
dateIndex = strsDate(2)

'人変化かどうか判断する
If peopleName = lastTimePeopleName Then

'日付変更かどうか判断する
If strDate = lastTimeStrDate Then
'当日、最後の時間は、退勤時間を保存する
peopleEndTimeList(Int(dateIndex)) = wks.Cells(i, 4).Value
Else

'初めて、日付け変化の場合、出勤時間です、出勤時間を保存する
peopleStartTimeList(Int(dateIndex)) = wks.Cells(i, 4).Value

'(※：一日中、一回の記録のみの可能性があります、この場合、二つ時間が同じ)
'最後の時間は､退勤時間を保存
peopleEndTimeList(Int(dateIndex)) = wks.Cells(i, 4).Value

End If

Else
'人変更、前回の人の出勤、退勤情報を保存する========================================start
Dim varCurrentPeopleStartTimeList(31)
Dim varCurrentPeopleEndTimeList(31)
For j = 0 To 31
varCurrentPeopleStartTimeList(j) = peopleStartTimeList(j)
varCurrentPeopleEndTimeList(j) = peopleEndTimeList(j)
Next

fingerprintStartTimeInfo.Add lastTimePeopleName, varCurrentPeopleStartTimeList
fingerprintEndTimeInfo.Add lastTimePeopleName, varCurrentPeopleEndTimeList
'Erase peopleEndTimeList
For k = 0 To 31
peopleStartTimeList(k) = ""
peopleEndTimeList(k) = ""
Next

lastTimeStrDate = ""
'前回の人の出勤、退勤情報を保存する========================================end

'人変更の初回、人の出勤、退勤情報を保存する========================================start
'日付変更かどうか判断する
If strDate = lastTimeStrDate Then
'当日、最後の時間は、退勤時間を保存する
peopleEndTimeList(Int(dateIndex)) = wks.Cells(i, 4).Value
Else

'初めて、日付け変化の場合、出勤時間です、出勤時間を保存する
peopleStartTimeList(Int(dateIndex)) = wks.Cells(i, 4).Value

'(※：一日中、一回の記録のみの可能性があります、この場合、二つ時間が同じ)
'最後の時間は､退勤時間を保存
peopleEndTimeList(Int(dateIndex)) = wks.Cells(i, 4).Value

End If
'次回人の出勤、退勤情報を保存する========================================end

End If

lastTimeStrDate = strDate
lastTimePeopleName = peopleName

Next
'★★★Read　fingerprint INFO end★★★

GoTo endok
errl:
'異常処理
ERROR_FLG = "1"
ERROR_INFO_LIST.Add ("関数「setFingerprintInfoIntoDictionary」で、エラー発生しました。")
ERROR_INFO_LIST.Add ("エラー詳細：" & Err.Number & " ： " & Err.Description)
endok:

End Sub

写入数据（OUT）

'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
'* 　　　　　　　　　 *
'* Write Out 指紋情報を出力対象に記入 　 *
'* 作成日：2017/08/13 *
'* 作成者：sun 　　　　　　　　　 *
'* 更新日：2017/08/13 　　　　　　　　 *
'* 更新者：sun 　　　　　　　　　　 *
'* *
'* * * * * * * * * * * * * * * * * * * *　* * * * * * * * *
Public Sub writeFingerprintInfoToOutFile(outWb As Workbook)

On Error GoTo errl

'人たち毎月の情報
Dim peopleStartTimeList(31) As String
Dim peopleEndTimeList(31) As String

'★★★Operate Out ファイル 指紋情報記入　start★★★
outWb.Activate
outWb.Sheets("LIST").Select

For i = 3 To 100

outWb.Sheets("LIST").Select
peopleName = Cells(i, 3).Value
peopleNumber = Cells(i, 2).Value

If peopleName = Empty Then
Exit For
End If

Sheets(peopleNumber).Select

If fingerprintStartTimeInfo.exists(peopleName) Then
Dim outFilePeopleStartTimeList()
Dim outFilePeopleEndTimeList()

outFilePeopleStartTimeList = fingerprintStartTimeInfo.Item(peopleName)
outFilePeopleEndTimeList = fingerprintEndTimeInfo.Item(peopleName)

'退勤時間を記録する
For j = 3 To 33
Cells(j, 4).Value = outFilePeopleStartTimeList(j - 3 + 1)
Cells(j, 5).Value = outFilePeopleEndTimeList(j - 3 + 1)

Next

'数式をTEXTへ転換 start
Range("G3:G33").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A1").Select
'数式をTEXTへ転換 end

End If

Next
'★★★Operate Out ファイル 指紋情報記入　end★★★

GoTo endok
errl:
'異常処理
ERROR_FLG = "1"
ERROR_INFO_LIST.Add ("関数「writeFingerprintInfoToOutFile」で、エラー発生しました。")
ERROR_INFO_LIST.Add ("エラー詳細：" & Err.Number & " ： " & Err.Description)
endok:

End Sub