こんにちは、脇保です。
さて、前回の続き。
↓前回
Felica（Pasori）とエクセル（とDelphiとかで）で自動勤怠アプリを作て見た１
とは行っても、対してする事は無くて（以前作ったものを利用した）、
それの小改良をしたのみなんですが・・・。
さて、何を書こう？？
取り敢えず、やるべきだった事、やった事、を書いていきます。
やる事 ：エクセルを使って、勤怠表を自動生成する仕組みを作る。
やるべき事：勤怠表をまず作る
記録（勤怠履歴）を参考に、勤怠を埋める
やった事 ：以前作った勤怠表アプリを改良して、
記録を読み込んで書き込む仕組みを作った。
な訳ですが。
ですが、かなり地味な作業で、特にこれといった事はしていません。
勤怠を自動生成する部分は、以前にかなり頑張りましたが。
・・・さて、どうしよう。
折角なので、エクセルから勤怠を読み込む仕組みを書いてみようかと。
（かなりテキトーな思いつき）
ただ、勤怠表は事前にすでにあるものとします。
先ず、最初の難関はファイルフォーマットの違い。
LinuxはUTF-8、対してWindowsはShitJis。
ここをうまく変換しないと、文字化けする事になってしまう。
参考に下のは以下のサイト
以下のサンプルを参考にさせていただきましたｍ（＿＿）ｍ。
https://tonari-it.com/vba-csv-utf8/
VBAを使って、読み込みます。
次に、シートを一枚追加します。
ここに、読み込んだCSVを貼り付けます。
シートに読み込んだら、
次はそれを勤怠に反映させます。
ここは地道な作業。
出来上がったのは以下になります。
ただ、途中で力つきまして、
IDと出勤者の紐付けまで行けませんでした。
ここは、事前に名前とIDを紐づけておいて、
該当する名前のIDがあったら、そこだけ拾うようにすれば、
普通にいけると思います。
Sub kintai()
dummy = loadutf8kintai(読み込みたいファイルのアドレス, “UTF-8”, 2)
writekintai
End Sub
Function loadutf8kintai(filepath, carset As String, SheetNo As Integer)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(SheetNo)
Dim i, j, k, m, r As Long
Dim strLine As String
Dim arrLine, arrLine2, arrLine3, arrLine4 As Variant ‘カンマでsplitして格納
‘ADODB.Streamオブジェクトを生成
Dim adoSt As Object
Set adoSt = CreateObject(“ADODB.Stream”)
i = 1
With adoSt
.Charset = carset ‘Streamで扱う文字コートをutf-8に設定
.Open ‘Streamをオープン
.LoadFromFile (filepath) ‘ファイルからStreamにデータを読み込む
k = 0
Do Until .EOS ‘Streamの末尾まで繰り返す
strLine = .ReadText(adReadLine) ‘Streamから1行取り込み
arrLine = Split(strLine, vbLf) ‘strLineをカンマで区切りarrLineに格納
For j = 0 To UBound(arrLine)
If k < 1 Then
arrLine2 = Split(arrLine(j), “,”)
For m = 0 To UBound(arrLine2)
arrLine4 = arrLine2
arrLine3 = Split(arrLine4(m), ” “)
For r = 0 To UBound(arrLine3)
ws.Cells(i, r + 2).Value = arrLine3(r)
Next r
ws.Cells(i, 1).Value = arrLine2(0)
ws.Cells(i, 2).Value = Left(arrLine2(1), 6)
Next m
k = k + 1
Else
k = 0
i = i + 1
End If
Next j
Loop
.Close
End With
End Function
Function writekintai()
Dim ws As Worksheet
Dim ws2 As Worksheet
Set ws = ThisWorkbook.Worksheets(1)
Set ws2 = ThisWorkbook.Worksheets(2)
Dim i, i2 As Integer
i2 = 1
maxrow = ws2.Range(“A1”).End(xlDown).Row
For i = 5 To 35 ‘勤怠表の日付欄を参照しながらループする
For i2 = 1 To maxrow
s = Right(ws2.Cells(i2, 2), 4) + “/” + Left(ws2.Cells(i2, 4), 2) + “/” + Left(ws2.Cells(i2, 5), 2)
s2 = ws.Cells(i, 2)
If InStr(s, s2) Then
If ws.Cells(i, 4) = “” Then
ws.Cells(i, 4) = ws2.Cells(i2, 7) ‘出勤
Else
ws.Cells(i, 5) = ws2.Cells(i2, 7) ‘退勤
End If
End If
Next i2
i2 = i2 + 1
Next i
End Function