Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1986 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

▼

【70645】VBAで三捨四入の計算をしたいのですが（先ほどは間違えて投稿してました） てつ 11/12/11(日) 20:13

【70646】Re:VBAで三捨四入の計算をしたいのですが（... UO3 11/12/11(日) 22:51

【70647】Re:VBAで三捨四入の計算をしたいのですが（... てつ 11/12/11(日) 23:35

【70651】Re:VBAで三捨四入の計算をしたいのですが（... UO3 11/12/12(月) 9:54

【70659】Re:VBAで三捨四入の計算をしたいのですが（... てつ 11/12/13(火) 22:15


	【70645】VBAで三捨四入の計算をしたいのですが（...

てつ - 11/12/11(日) 20:13 -


	引用なし

	パスワード

シートのＡ列の最初と最後という文字の間の行に開始時刻、Ｂ列に終了時刻が入っています。
また、時刻は文字列で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


	【70646】Re:VBAで三捨四入の計算をしたいのですが...

UO3 - 11/12/11(日) 22:51 -


	引用なし

	パスワード

▼てつさん：

こんばんは

表題の【三捨四入】なのか文中の【四捨六入】なのかも含めてコードの中身は
読んでいません。コードの記述方法としては気になるところも多々ありますし、
最初　や　最後　が　範囲を特定するためにシート上に記載してあるというものなら
それらがなくても処理はできますけど、それは横に置いておき。

おそらくはエクセル特有の【小数点の演算誤差】でしょうね。
「エクセル　演算誤差」あたりで検索しますと、参考ページがたくさんありますので
どれかに目を通しておいていただきたいのですが、今回のケースでいいますと、お困りの
部分は、0.25 が判定されていますよね。でも、実際に Select Cse に与えられた数値は
0.25 よりわずかに大きなもの、0.26よりは小さいものになっていると思われます。
従って　Case 0.16 To 0.25　でも　Case 0.26 To 0.35　でも対象にならないわけです。

Case 0.16 To 0.259 なんてすると、当面の回避はできると思いますが。


	【70647】Re:VBAで三捨四入の計算をしたいのですが...

てつ - 11/12/11(日) 23:35 -


	引用なし

	パスワード

UO3さん早速のご回答ありがとうございます。

>表題の【三捨四入】なのか文中の【四捨六入】なのかも含めてコードの中身は
>読んでいません。

分かりにくい表現で申し訳ありません。６分を０．１時間とした場合に３分以下は切り捨て４分以上は切り上げということです。

>最初　や　最後　が　範囲を特定するためにシート上に記載してあるというものなら
>それらがなくても処理はできますけど、それは横に置いておき。

最初と最後の間の行数は一定ではないのですが大丈夫でしょうか

>
>おそらくはエクセル特有の【小数点の演算誤差】でしょうね。
>「エクセル　演算誤差」あたりで検索しますと、参考ページがたくさんありますので
>どれかに目を通しておいていただきたいのですが、今回のケースでいいますと、お困りの
>部分は、0.25 が判定されていますよね。でも、実際に Select Cse に与えられた数値は
>0.25 よりわずかに大きなもの、0.26よりは小さいものになっていると思われます。
>従って　Case 0.16 To 0.25　でも　Case 0.26 To 0.35　でも対象にならないわけです。
>
>Case 0.16 To 0.259 なんてすると、当面の回避はできると思いますが。

ありがとうございます。早速試してみます。


	【70651】Re:VBAで三捨四入の計算をしたいのですが...

UO3 - 11/12/12(月) 9:54 -


	引用なし

	パスワード

▼てつさん：

おはようございます。

とりあえずの間に合わせとして、Case 0.16 To 0.259 を提示しました。
（よく考えると、Case 0.16 To 0.251 でもいいはずですけど）
既に検索して関連情報を把握されたかとは思いますが、エクセルは
効率優先のため、小数点演算は「超々々々近似値演算」によって処理しています。
効率は若干おちますが（といって、気にするレベルではありません）これを
強制的に「１０進演算」で処理した結果で取得するには、たとえば
CDec関数を使います。
Select Case CDec(t3 - Fix(t3))
こうしますと、もとの　Case 0.16 To 0.25　でもＯＫのはずです。
お試しください。

>最初と最後の間の行数は一定ではないのですが大丈夫でしょうか

もし、データ開始行が 1行目あるいは2行目。で、データのある最後の行まで
という仕様であれば、最後の行を動的にＶＢＡで把握することができます。
ただ、もしかしたら、本当に、固定されていない行から始まり、最後のデータ行の
下に、別のデータがあって、その中で、時間データを抽出しなければいけないと
いうことであれば、現在のコードでＯＫです。（Matchを使う手もありますが）

ただ、念のための、有無をNothingかどうかでチェックしておられるところは
いいのですが、なかった場合、メッセージを出すものの、
For i = Gy1 + 1 To Gy2 - 1　以降の処理がされてしまいますね。
メッセージ（２ヶ所）を出した後に、Exit Sub をいれておかれればよろしいかと。

実行のタイミングがWorksheet_SelectionChange。
これはこれで、なかなか考えられた起動方法だなぁとも思いますが、
たとえばシートのデータを変更するために、どこかのセルを選択するたびに
実行されてしまいます。
むしろ、普通のプロシジャとして標準モジュールに記述し、マクロショートカットキーで
呼び出すなり、シートにボタンを配置して、そのクリックで起動するなりのほうが
扱いやすいかもしれません。

変数規定は、それを使う前に宣言すればいいわけですが、コードの可読性、保守性の
観点から、コードの最初に集めておいたほうがよろしいですね。

また、インデントは「適切」につけないと、かえって可読性が悪くなります。

ということで、そういった部分だけお化粧直しをしました。

Sub Sample()
　　Dim Gy1 As Variant, Gy2 As Variant, i As Long
　　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
　　
　　Gy1 = Application.Match("最初", Columns("A"), 0)
　　If Not IsNumeric(Gy1) Then
　　　　MsgBox "最初の文字列がありません"
　　　　Exit Sub
　　Else
　　　　Gy1 = Gy1 + 1
　　End If
　　
　　Gy2 = Application.Match("最後", Columns("A"), 0)
　　If Not IsNumeric(Gy2) Then
　　　　MsgBox "最後の文字列がありません"
　　　　Exit Sub
　　Else
　　　　Gy2 = Gy2 - 1
　　End If

　　For i = Gy1 To Gy2
　　
　　　　If WorksheetFunction.CountBlank(Range("A" & i & ":B" & i)) > 0 Then
　　　　　　'検索範囲のＡ or Ｂ列が空白の場合は時数は空白とする
　　　　　　Range(i, "C").ClearContents
　　　　Else
　　　　　　myH1 = Mid(Cells(i, 1).Value, 1, 2) 'Ａ列の「時」を取得
　　　　　　myM1 = Mid(Cells(i, 1).Value, 3)　　'Ａ列の「分」を取得
　　　　　　myH2 = Mid(Cells(i, 2).Value, 1, 2) 'Ｂ列の「時」を取得
　　　　　　myM2 = Mid(Cells(i, 2).Value, 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 CDec(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


	【70659】Re:VBAで三捨四入の計算をしたいのですが...

てつ - 11/12/13(火) 22:15 -


	引用なし

	パスワード

UO3 さん：
こんばんは。非常に分かりやすいご回答ありがとうございます。返信遅くなって申し訳ありませんでした。

>効率は若干おちますが（といって、気にするレベルではありません）これを
>強制的に「１０進演算」で処理した結果で取得するには、たとえば
>CDec関数を使います。
>Select Case CDec(t3 - Fix(t3))
>こうしますと、もとの　Case 0.16 To 0.25　でもＯＫのはずです。
>お試しください。

早速、試してみましたが、完璧に計算してくれます。
前回アドバイス頂いたように実行した場合、一部計算できない部分があったのですが、CDecを使うと完璧に計算してくれますね。

>もし、データ開始行が 1行目あるいは2行目。で、データのある最後の行まで
>という仕様であれば、最後の行を動的にＶＢＡで把握することができます。
>ただ、もしかしたら、本当に、固定されていない行から始まり、最後のデータ行の
>下に、別のデータがあって、その中で、時間データを抽出しなければいけないと
>いうことであれば、現在のコードでＯＫです。（Matchを使う手もありますが）

おっしゃる通り、固定されていない行から始まりますので現状のままと思いましたが、これもまたMatch関数を使うとすっきりしますね。使わせていただきたいと思います。

>ただ、念のための、有無をNothingかどうかでチェックしておられるところは
>いいのですが、なかった場合、メッセージを出すものの、
>For i = Gy1 + 1 To Gy2 - 1　以降の処理がされてしまいますね。
>メッセージ（２ヶ所）を出した後に、Exit Sub をいれておかれればよろしいかと。

ご指摘ありがとうございます。失念していました。

>実行のタイミングがWorksheet_SelectionChange。
>これはこれで、なかなか考えられた起動方法だなぁとも思いますが、
>たとえばシートのデータを変更するために、どこかのセルを選択するたびに
>実行されてしまいます。
>むしろ、普通のプロシジャとして標準モジュールに記述し、マクロショートカットキーで
>呼び出すなり、シートにボタンを配置して、そのクリックで起動するなりのほうが
>扱いやすいかもしれません。

ここもご指摘の通りと思いますが、総合的に判断して取り敢えず現状のままとしたいと思います。使用してみて不具合が発生した時は再考したいと思います。

>変数規定は、それを使う前に宣言すればいいわけですが、コードの可読性、保守性の
>観点から、コードの最初に集めておいたほうがよろしいですね。

ありがとうございます。

>また、インデントは「適切」につけないと、かえって可読性が悪くなります。

悩んだ末の指定だったのですが…なかなか難しいですね。

>Sub Sample()
>　　Dim Gy1 As Variant, Gy2 As Variant, i As Long
>　　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
>　　
>　　Gy1 = Application.Match("最初", Columns("A"), 0)
>　　If Not IsNumeric(Gy1) Then
>　　　　MsgBox "最初の文字列がありません"
>　　　　Exit Sub
>　　Else
>　　　　Gy1 = Gy1 + 1
>　　End If
>　　
>　　Gy2 = Application.Match("最後", Columns("A"), 0)
>　　If Not IsNumeric(Gy2) Then
>　　　　MsgBox "最後の文字列がありません"
>　　　　Exit Sub
>　　Else
>　　　　Gy2 = Gy2 - 1
>　　End If
>
>　　For i = Gy1 To Gy2
>　　
>　　　　If WorksheetFunction.CountBlank(Range("A" & i & ":B" & i)) > 0 Then
>　　　　　　'検索範囲のＡ or Ｂ列が空白の場合は時数は空白とする
>　　　　　　Range(i, "C").ClearContents

ここの部分はLenを使って、４文字以外はClearContentsというものにしたいと思います。Ａ、Ｂ列に時間を入力する際に、入力ミスで４桁以外の場合にエラーとなってしまうためです。

>　　　　Else
>　　　　　　myH1 = Mid(Cells(i, 1).Value, 1, 2) 'Ａ列の「時」を取得
>　　　　　　myM1 = Mid(Cells(i, 1).Value, 3)　　'Ａ列の「分」を取得
>　　　　　　myH2 = Mid(Cells(i, 2).Value, 1, 2) 'Ｂ列の「時」を取得
>　　　　　　myM2 = Mid(Cells(i, 2).Value, 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 CDec(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

これを参考にもう一度自分なりに組み立ててみたいと思います。
貴重なお時間割いていただいて誠にありがとうございました。
またお時間がありましたらご指導いただければ幸いです。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1986 / 13645 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free