３桁または４桁の数値を時刻に変換したい

質問

Excel2003でマクロ作成の初心者です。
３桁または４桁の数字を時刻に変更したいです。
　　820→8：20　　1020→10：20
ネットで捜したら、見つかりましたが、これを実行すると問題点があります。
ア）.NumberFormatLocal = "h:mm;@"を使うとエラーがでるので
　　実行時エラ－1004
　　rangeクラスの　NumberFormatLocalプロパティを設定できません。
イ） .Formula = Left(t, 2) & ":" & Right(t, 2)に変更しましたが
　　　1020はできましたが、820はできません。
　　　'0820 とするとできます。
　　これを「'」をいれなくとも　8：20　のようにしたいです。
ウ）また数値を入力したセルを削除すると即座に
　実行時エラー13　型が一致しません。とでます。
　　これを出ないようにしたいのです。
------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As String
t = Target.Value
'時間に変換する場所を制限します。
'デフォルトでは「A1」と「C1からD2」に入力した場合のみ処理が実行されます
If Application.Intersect(Target, Range("A1,C1:D2")) Is Nothing Then Exit Sub
'入力された数値が4桁以外の場合ははじかれます。
If Len(t) <> 4 Then Exit Sub
With Target
'セルの書式を時間に設定します。
.NumberFormatLocal = "h:mm;@"
'四桁の数字に「：」を追加します。
'この部分はほかにもいろいろな方法があると思います。ので変えてください。
.Formula = Left(t, 2) & ":" & Right(t, 2)
End With
End Sub

回答No.4

mar00 · ベストアンサー

表示だけの事なら
書式設定で#0":"00でいいと思います。

あえてマクロにするなら
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Range("A1,C1:D2")) Is Nothing Then Exit Sub
Target.NumberFormatLocal = "#0"":""00"
End Sub

質問者さんのマクロに追加するならば
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As String
On Error Resume Next　(1)
t = Target.Value
If Application.Intersect(Target, Range("A1,C1:D2")) Is Nothing Then Exit Sub
If Len(t) = 3 Then t = "0" & t　(2)
If Len(t) = 2 Then t = "00" & t　(3)
If Len(t) = 1 Then t = "000" & t　(4)
If Len(t) <> 4 Then Exit Sub
With Target
.NumberFormatLocal = "h:mm;@"
.Formula = Left(t, 2) & ":" & Right(t, 2)
End With
End Sub
(1)～(4)を追加します。

お礼

まったくマクロの入ってないシートで試したところ、見事にできました。
ということは、私のシートに何らかの原因があることがはっきりしてきました。
これまで大変お世話になりました。あとは自分で原因究明するしかないので
質問をいったん締め切りたいと思います。本当にありがとうございました。
貴方様のコードは３件以外完璧にできましたので、これを参考にして原因究明したいとおもいます。

補足

パートに時間計算に使用しているので、ＶＢＡでやりたいです。
教えていただいたコードを自分のセルに修正し実行してみました。エラー処理もできて
ほぼ近づいてきました。しかし原因不明の処理ができません。この３件だけです。
600→0.：25　　1200→00：.5　　1800→0.：75　この３件が正常にできるようにしたいです。
私のD63:O93,AF63:AL93は４列とも横方向にセルの結合をしています。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As String
On Error Resume Next
t = Target.Value
If Application.Intersect(Target, Range("D63:O93,AF63:AL93")) Is Nothing Then Exit Sub
If Len(t) = 3 Then t = "0" & t
If Len(t) = 2 Then t = "00" & t
If Len(t) = 1 Then t = "000" & t
With Target
If Len(t) <> 4 Then Exit Sub
.NumberFormatLocal = "h:mm;@"
.Formula = Left(t, 2) & ":" & Right(t, 2)
End With
End Sub

回答No.8

ytsg

No.1です。
一応全コード表示しておきます。
****************************************************************
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t As String
t = Target.Value
'時間に変換する場所を制限します。
'デフォルトでは「A1」と「C1からD2」に入力した場合のみ処理が実行されます
If Application.Intersect(Target, Range("A1,C1:D2")) Is Nothing Then Exit Sub

If Len(t) < 4 Then t = "0" & t　　'追加１

'入力された数値が4桁以外の場合ははじかれます。
If Len(t) <> 4 Then Exit Sub

With Target
'セルの書式を時間に設定します。
.NumberFormatLocal = "h:mm;@"
'四桁の数字に「：」を追加します。
'この部分はほかにもいろいろな方法があると思います。ので変えてください。
Application.EnableEvents = False　　'追加２
.Formula = Left(t, 2) & ":" & Right(t, 2)
Application.EnableEvents = True　　'追加３

End With

End Sub
**************************************************

No.6の方が書いておられるように、試行錯誤している段階でセルがおかしな状態になっているのでは？
A1、,C1:D2のセルの書式を標準に戻して試してみてはいかがでしょうか。

お礼

まったくマクロの入ってないシートで試したところ、見事にできました。
ということは、私のシートに何らかの原因があることがはっきりしてきました。
これまで大変お世話になりました。あとは自分で原因究明するしかないので
質問をいったん締め切りたいと思います。本当にありがとうございました。

回答No.7

hidetora1900

エクセルって、そんな長いプログラムが必要なんですか？

(-.-)

回答No.6

tom04

No.3です！
補足を読ませていただきました。

ん～～～
原因が判りかねますが、変数「t」をString型でなく、Variant型かLong（長整数）型で宣言してみてはどうでしょうか？

せっかくコードをお考えなので、余計なお世話かもしれませんが・・・
こちらでコードを作ってみました。

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A1,C1:D2")) Is Nothing Then Exit Sub
Dim t As Variant
t = Target
If t > 2400 Or t Mod 100 >= 60 Then
MsgBox ("入力値が不正です、" & vbCrLf & "再入力してください。")
With Target
.ClearContents
.Select
.NumberFormatLocal = "G/標準"
End With
Exit Sub
Else
Application.EnableEvents = False
With Target
.NumberFormatLocal = "h:mm"
.Value = Int(t / 100) & ":" & t Mod 100
End With
Application.EnableEvents = True
End If
End Sub

※　入力値が24時を超えたり、分の部分（下二桁）が60以上にした場合はメッセージボックスを表示させ、再入力するようにしてみました。

※　一旦エラーが出てしまった場合何らかの残骸が残っているかもしれませんので、別Sheetで試してみてください。

余計なお世話だったらごめんなさいね。m(_ _)m

お礼

まったくマクロの入ってないシートで試したところ、見事にできました。
ということは、私のシートに何らかの原因があることがはっきりしてきました。
これまで大変お世話になりました。あとは自分で原因究明するしかないので
質問をいったん締め切りたいと思います。本当にありがとうございました。

補足

教えていただいたとおり、書き直し740と入力してエンターを押したとたん
実行時えらー1004　Rangeクラスの　NumberFormatLocalプロパティ設定できません。となります。

回答No.5

ytsg

No1の者です。

＞そして、今偶然きがついたのですが、600→0.:25　1200→00:.5　1800→0.:75　という風にこの３つは
＞おかしなことにできませんでした。なぜなんでしょうか？

.Formula = Left(t, 2) & ":" & Right(t, 2)の時にWorksheetのChangeイベントが起こってしまっているので
値がおかしくなってしまっています。

下記3行目の「Application.EnableEvents = False」と5行目の「Application.EnableEvents = True」を追加してください。
**********************************
'四桁の数字に「：」を追加します。
'この部分はほかにもいろいろな方法があると思います。ので変えてください。
Application.EnableEvents = False
.Formula = Left(t, 2) & ":" & Right(t, 2)
Application.EnableEvents = True
**********************************

Application.EnableEvents = False　とすることでマクロで処理している置き換えではChangeイベントを起こさないということです。
正しい値を書き込み終わったら「Application.EnableEvents = True」でイベントを復活させます。

補足

教えていただいたとおり、書き直し740と入力してエンターを押したとたん
実行時えらー1004　Rangeクラスの　NumberFormatLocalプロパティ設定できません。となります。

回答No.3

tom04

こんにちは！
一案です。

With Target
.NumberFormatLocal = "h:mm"
.Value = WorksheetFunction.RoundDown(t / 100, 0) & ":" & Right(t, 2)
End With

といった感じにしてみてはどうでしょうか？m(__)m

補足

今実験しましたら　600→0：25　　1800→0.0520833　　
　　1200→　実行時エラー　型が一致しません　という不思議な現象になりました。

回答No.2

DIooggooID

表示形式に拘っていらっしゃるのでしたら、

ＶＢＡなどは使用せずに、　単にそのセルの表示形式を

　　【ユーザ定義】で、　　00":"00

にする手段でも良いと思います。

回答No.1

ytsg

修正を一番少なくするには
＞'デフォルトでは「A1」と「C1からD2」に入力した場合のみ処理が実行されます
＞If Application.Intersect(Target, Range("A1,C1:D2")) Is Nothing Then Exit Sub
と
＞'入力された数値が4桁以外の場合ははじかれます。
＞If Len(t) <> 4 Then Exit Sub
の間に

'4桁未満なら前に0を追加
If Len(Target) < 4 Then t = "0" & t

を追加します。
マクロ内ですでに数値を文字列として保持している（Dim t As String）ので
結果として'0820と入力したのと同じことになります。

補足

今早速教えていただいたとおりやってみました。３桁でもうまくできました。
そして、今偶然きがついたのですが、600→0.:25　1200→00:.5　1800→0.:75　という風にこの３つは
おかしなことにできませんでした。なぜなんでしょうか？