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 endokerrl:    '異常処理     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 endokerrl:    '異常処理     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 endokerrl:    '異常処理     ERROR_FLG = "1"     ERROR_INFO_LIST.Add ("関数「writeFingerprintInfoToOutFile」で、エラー発生しました。")     ERROR_INFO_LIST.Add ("エラー詳細：" & Err.Number & " ： " & Err.Description)endok:End Sub