ゴリラストロングの雑記帳

月収10万円の広告収入を目指す自称専業ライターのブログです。




【Excel VBA】勤怠データ管理。社員の入退室記録を転記するマクロ。




どうも、ゴリラストロングです。

 

 

勤怠データ管理において、社員の入退室記録を転記するマクロを作成してみました。

 

 

<元データ>

f:id:gorilla-strong:20200227084223p:plain

 

 

<マクロ実行後>

f:id:gorilla-strong:20200227084541p:plain

 

 

<機能解説>

元データの右側、最終列の隣に新たに枠を作り、Vlookupでデータを引っ張ってくる。

C~F列にそれぞれ「平均入室時間」「 平均退室時間」「 平均滞在時間」「 合計滞在時間」を計算する。

 

 

 スポンサーリンク

 

 

ソースコード

Sub 社員の入退室データ()



Dim NT As Object
Set NT = Workbooks("ゴリラストロングの雑記帳2.xlsm").Worksheets("社員の入退室データ")

NT.Range("C:F").Insert



NT.Range("C3") = "平均入室時間"
NT.Range("D3") = "平均退室時間"
NT.Range("E3") = "平均滞在時間"
NT.Range("F3") = "合計滞在時間"



NT.Range("C:F").Columns.AutoFit



Dim lastcolumn As Long
lastcolumn = NT.Cells(2, Columns.Count).End(xlToLeft).Column

Dim hiduke As String
hiduke = InputBox("日付を入力してください。")

NT.Cells(2, lastcolumn + 2) = hiduke




NT.Range(Cells(2, lastcolumn + 2), Cells(2, lastcolumn + 3)).Merge



Dim range1 As Range
Set range1 = NT.Cells(2, lastcolumn + 2)
range1.HorizontalAlignment = xlCenter
range1.VerticalAlignment = xlTop



NT.Cells(3, lastcolumn + 2) = "入室"
NT.Cells(3, lastcolumn + 3) = "退室"



Dim range2 As Range
Set range2 = NT.Range(Cells(3, lastcolumn + 2), Cells(3, lastcolumn + 3))
range2.HorizontalAlignment = xlCenter
range2.VerticalAlignment = xlTop



Dim lastrow As Long
lastrow = NT.Cells(Rows.Count, 1).End(xlUp).Row


NT.Range(Cells(2, lastcolumn + 2), Cells(lastrow, lastcolumn + 3)).Borders.LineStyle = True






Dim OpenFileName As String
    OpenFileName = Application.GetOpenFilename("Microsoft Excelブック,*.xls?")
    Workbooks.Open OpenFileName
    
    


Dim data As Object
Set data = Workbooks(2).Worksheets(1)



For i = 4 To lastrow



NT.Cells(i, lastcolumn + 2) = WorksheetFunction.VLookup(NT.Range("A" & i), data.Range("A:D"), 3, False)
NT.Cells(i, lastcolumn + 3) = WorksheetFunction.VLookup(NT.Range("A" & i), data.Range("A:D"), 4, False)

Next


NT.Activate

NT.Range(Columns(lastcolumn + 2), Columns(lastcolumn + 3)).NumberFormatLocal = "[h]:mm"



Cells(2, lastcolumn + 2).NumberFormatLocal = "yyyy/m/d"



Dim lastcolumn2 As Long
lastcolumn2 = NT.Cells(2, Columns.Count).End(xlToLeft).Column

Dim daynum As Long
daynum = WorksheetFunction.CountA(Range(Cells(2, 7), Cells(2, lastcolumn2)))


For j = 4 To lastrow



NT.Range("C" & j) = WorksheetFunction.Average(Cells(j, 7), Cells(j, 9), Cells(j, 11), Cells(j, 13), Cells(j, 15), Cells(j, 17))
NT.Range("D" & j) = WorksheetFunction.Average(Cells(j, 7 + 1), Cells(j, 9 + 1), Cells(j, 11 + 1), Cells(j, 13 + 1), Cells(j, 15 + 1), Cells(j, 17 + 1))
NT.Range("E" & j) = NT.Range("D" & j) - NT.Range("C" & j)
NT.Range("F" & j) = NT.Range("E" & j) * daynum

Next



NT.Range(Columns(3), Columns(6)).NumberFormatLocal = "[h]:mm"



NT.Range("C4", "F" & lastrow).Interior.ColorIndex = 4



End Sub

 

 

<問題点>

NT.Range("C" & j) = WorksheetFunction.Average(Cells(j, 7), Cells(j, 9), Cells(j, 11), Cells(j, 13), Cells(j, 15), Cells(j, 17))

問題点が一つあり、上記のコードを見ていただいたら分かると思うのですが、平均を計算する式のセルが一部絶対値で入力されています。

これはセルの範囲選択がうまくできなかったためです。

どなたかお詳しい方がいましたら、セルを一列おきに選択する方法をご教示いただければと思います。

今回は思ったより難しかったです。

 

 

以上、ゴリラストロングでした。

 

 スポンサーリンク