アンケートや勤怠などで、何時間何分したかを書いてあるのがあります。
このままだと計算できないので、変換するマクロを作りました。
例えば27時間2分30秒なら、27:02:30という具合に右隣りのセルに書き込みます。
書式設定もします。
Option Explicit
Public Sub countTime()
Dim idxHour As Integer
Dim idxMinute As Integer
Dim idxSecond As Integer
Dim h As String
Dim m As String
Dim s As String
Dim ws As Worksheet
Dim rowStart As Integer
Dim rowEnd As Integer
Dim col As Integer
Dim cel As Range
Dim i As Integer
Dim j As Integer
Dim r As String
'現在のワークシートを取得
Set ws = ActiveSheet
'アクティブなセルから開始するので取得
Set cel = ActiveCell
'セル範囲を把握するために行と列番号を取得
col = cel.Column
rowStart = cel.Row
With ws
'アクティブセルのある列の一番最後のデータ位置を取得
rowEnd = .Cells(.Rows.Count, col).End(xlUp).Row
'行の番号でループする
For i = rowStart To rowEnd
'ここでは、例として、17時間20分3秒という感じのデータを想定。
'但し、時間、分、秒のどれかの部分がなくても大丈夫
'例えば2時間40秒というのもOK
'以下がメインの処理
idxHour = InStr(.Cells(i, col), "時間")
idxMinute = InStr(.Cells(i, col), "分")
idxSecond = InStr(.Cells(i, col), "秒")
If idxHour > 0 Then
h = Left(.Cells(i, col), idxHour - 1)
Else
h = "0"
End If
If idxMinute > 0 And idxHour > 0 Then
m = Mid(.Cells(i, col), idxHour + 2, idxMinute - (idxHour + 2))
ElseIf idxMinute > 0 Then
m = Left(.Cells(i, col), idxMinute - 1)
Else
m = "0"
End If
If idxSecond > 0 Then
If idxMinute > 0 Then
s = Mid(.Cells(i, col), idxMinute + 1, idxSecond - (idxMinute + 1))
ElseIf idxHour > 0 Then
s = Mid(.Cells(i, col), idxHour + 2, idxSecond - (idxHour + 2))
Else
s = Left(.Cells(i, col), idxSecond - 1)
End If
Else
s = "0"
End If
'結果を文字列連携で作成
r = h & ":" & m & ":" & s
'右隣のセルに書き込む
.Cells(i, col + 1) = r
'23時を超えて表示できるように書式設定をする
.Cells(i, col + 1).NumberFormatLocal = "[h]:mm:ss"
Next i
End With
End Sub
