| |
シートのＡ列の最初と最後という文字の間の行に開始時刻、Ｂ列に終了時刻が入っています。
また、時刻は文字列で0000の形式で入力されています。7時でしたら0700といった感じです。
Ａ列 Ｂ列 Ｃ列
最初
0700 0715
1102 1200
0958 1200
1045 1100
1145 1200
1245 1300
1030 1200
最後
Ｃ列にＢ列からＡ列を引いた時間の「分」の部分を四捨六入して0.0時間と表示したいと思い次のように計算してみました。しかし、作ったは良いのですが、1145から1200を計算してくれません。不具合個所をご指導いただけないでしょうか。また、検算の方法がありましたらご教授願いします。初心者が組んだものですので見づらいとは思いますがご了承ください。
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Foundcell1 As Range, Foundcell2 As Range
Dim Ce1 As Range, Ce2 As Range
Dim Gy1 As Long, Gy2 As Long, i As Long
Set Foundcell1 = Range("A:A").Find(What:="最初")
If Foundcell1 Is Nothing Then '最初がない場合
MsgBox "検索に失敗しました"
Else
Set Ce1 = Foundcell1
Gy1 = Ce1.Row 'Gy1の行番号を取得
End If
Set Foundcell2 = Range("A:A").Find(What:="最後")
If Foundcell2 Is Nothing Then '最後がない場合
MsgBox "検索に失敗しました"
Else
Set Ce2 = Foundcell2
Gy2 = Ce2.Row 'Gy2の行番号を取得
End If
For i = Gy1 + 1 To Gy2 - 1
If (Cells(i, 1) = "" And Cells(i, 2) = "") Or (Cells(i, 1) = "" Or Cells(i, 2) = "") Then
Cells(i, 3) = " " '検索範囲のＡ or Ｂ列およびＡ and Ｂ列が空白の場合は時数は空白とする
Else
Dim myH1 As Integer, myH2 As Integer, myS As Integer
Dim myM1 As Integer, myM2 As Integer
Dim T As Variant, t1 As Double, t2 As Double, t3 As Double, M As Double
Dim myM As Integer
myH1 = Mid(Cells(i, 1), 1, 2) 'Ａ列の「時」を取得
myM1 = Mid(Cells(i, 1), 3) 'Ａ列の「分」を取得
myH2 = Mid(Cells(i, 2), 1, 2) 'Ｂ列の「時」を取得
myM2 = Mid(Cells(i, 2), 3) 'Ｂ列の「分」を取得
myS = "00"
t1 = TimeSerial(myH1, myM1, myS) 'Ａ列の文字を時刻に変換する
t2 = TimeSerial(myH2, myM2, myS) 'Ｂ列の文字を時刻に変換する
t3 = (t2 - t1) * 24 'ＡからＢの時間を計算する
T = Int(t3)
If t1 >= t2 Then 'Ｂ列よりもＡ列が大きいときは「エラー」と表示する
Cells(i, 3) = "エラー"
ElseIf t3 - Fix(t3) < 0 Then '「分」を四捨六入し、０．０時間表示する
Cells(i, 3) = T
Else
Select Case t3 - Fix(t3)
Case 0 To 0.05
Cells(i, 3) = T
Case 0.06 To 0.15
Cells(i, 3) = T + 0.1
Case 0.16 To 0.25
Cells(i, 3) = T + 0.2
Case 0.26 To 0.35
Cells(i, 3) = T + 0.3
Case 0.36 To 0.45
Cells(i, 3) = T + 0.4
Case 0.46 To 0.55
Cells(i, 3) = T + 0.5
Case 0.56 To 0.65
Cells(i, 3) = T + 0.6
Case 0.66 To 0.75
Cells(i, 3) = T + 0.7
Case 0.76 To 0.85
Cells(i, 3) = T + 0.8
Case 0.86 To 0.95
Cells(i, 3) = T + 0.9
Case 0.96 To 0.99
Cells(i, 3) = T + 1
End Select
End If
End If
Next i
End Sub
|
|
てつ
- 11/12/11(日) 20:13 -
