
Excel2003でマクロ作成の初心者です。
3桁または4桁の数字を時刻に変更したいです。
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ベストアンサー
- 回答日時:
表示だけの事なら
書式設定で#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)を追加します。
この回答への補足
パートに時間計算に使用しているので、VBAでやりたいです。
教えていただいたコードを自分のセルに修正し実行してみました。エラー処理もできて
ほぼ近づいてきました。しかし原因不明の処理ができません。この3件だけです。
600→0.:25 1200→00:.5 1800→0.:75 この3件が正常にできるようにしたいです。
私のD63:O93,AF63:AL93は4列とも横方向にセルの結合をしています。
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
まったくマクロの入ってないシートで試したところ、見事にできました。
ということは、私のシートに何らかの原因があることがはっきりしてきました。
これまで大変お世話になりました。あとは自分で原因究明するしかないので
質問をいったん締め切りたいと思います。本当にありがとうございました。
貴方様のコードは3件以外完璧にできましたので、これを参考にして原因究明したいとおもいます。
No.8
- 回答日時:
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 '追加1
'入力された数値が4桁以外の場合ははじかれます。
If Len(t) <> 4 Then Exit Sub
With Target
'セルの書式を時間に設定します。
.NumberFormatLocal = "h:mm;@"
'四桁の数字に「:」を追加します。
'この部分はほかにもいろいろな方法があると思います。ので変えてください。
Application.EnableEvents = False '追加2
.Formula = Left(t, 2) & ":" & Right(t, 2)
Application.EnableEvents = True '追加3
End With
End Sub
**************************************************
No.6の方が書いておられるように、試行錯誤している段階でセルがおかしな状態になっているのでは?
A1、,C1:D2のセルの書式を標準に戻して試してみてはいかがでしょうか。
まったくマクロの入ってないシートで試したところ、見事にできました。
ということは、私のシートに何らかの原因があることがはっきりしてきました。
これまで大変お世話になりました。あとは自分で原因究明するしかないので
質問をいったん締め切りたいと思います。本当にありがとうございました。
No.6
- 回答日時:
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
- 回答日時:
No1の者です。
>そして、今偶然きがついたのですが、600→0.:25 1200→00:.5 1800→0.:75 という風にこの3つは
>おかしなことにできませんでした。なぜなんでしょうか?
.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.2
- 回答日時:
表示形式に拘っていらっしゃるのでしたら、
VBAなどは使用せずに、 単にそのセルの表示形式を
【ユーザ定義】で、 00":"00
にする手段でも良いと思います。
No.1
- 回答日時:
修正を一番少なくするには
>'デフォルトでは「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と入力したのと同じことになります。
この回答への補足
今早速教えていただいたとおりやってみました。3桁でもうまくできました。
そして、今偶然きがついたのですが、600→0.:25 1200→00:.5 1800→0.:75 という風にこの3つは
おかしなことにできませんでした。なぜなんでしょうか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) excel2021で実行できないマクロ。どこを直したらいいのか 2 2022/03/28 03:40
- Visual Basic(VBA) 【再々投稿】VBAのプログラムで動作しなくて困っています 8 2022/10/14 09:06
- Visual Basic(VBA) VBAのトグルボタンでのマクロについて質問です 3 2022/10/10 17:23
- Visual Basic(VBA) 【再投稿】VBAで動作しなくて困っています 2 2022/10/11 11:05
- Visual Basic(VBA) ExcelのVBAコードについて教えてください。 2 2022/05/26 17:19
- Visual Basic(VBA) 【追加】ファイルを閉じてダイアログで保存した時だけ処理の実行をする 3 2022/03/23 15:43
- Visual Basic(VBA) 【Excel VBA】自動メール送信の機能追加 5 2022/09/29 12:53
- Visual Basic(VBA) 【VBA】写真の貼り付けコードがうまく機能しません。 5 2022/09/01 18:43
- Excel(エクセル) VBAについて 3 2022/06/19 18:19
- Visual Basic(VBA) エクセルのVBAでダブルクリックでチェックを入れたあと 1 2022/10/26 20:30
このQ&Aを見た人はこんなQ&Aも見ています
関連するカテゴリからQ&Aを探す
おすすめ情報
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ExcelVBAを使って、値...
-
i=cells(Rows.Count, 1)とi=cel...
-
VBA実行後に元のセルに戻りたい
-
エクセルvbaで、別シートの最下...
-
任意フォルダから画像をすべて...
-
特定のセルが空白だったら、そ...
-
セル色なしの行一括削除
-
Excelで指定した日付から過去の...
-
【Excel VBA】指定行以降をクリ...
-
Excel vbaで特定の文字以外が入...
-
EXCELのVBA-フィルタ抽出後の...
-
エクセルVBAでコピーして順...
-
Excelのプルダウンで2列分の情...
-
Excel VBAで、 ヘッダーへのセ...
-
vb.netによるEXCEL値取得
-
Excel VBA、 別ブックの最終行...
-
連続する複数のセル値がすべて0...
-
【Excel】指定したセルの名前で...
-
VBAでセルをクリックする回...
-
TODAY()で設定したセルの日付...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelVBAを使って、値...
-
Excelで指定した日付から過去の...
-
エクセルvbaで、別シートの最下...
-
i=cells(Rows.Count, 1)とi=cel...
-
特定のセルが空白だったら、そ...
-
Excelのプルダウンで2列分の情...
-
【Excel VBA】指定行以降をクリ...
-
任意フォルダから画像をすべて...
-
VBAでセルをクリックする回...
-
”戻り値”が変化したときに、マ...
-
VBA実行後に元のセルに戻りたい
-
Excel vbaで特定の文字以外が入...
-
【VBA】シート上の複数のチェッ...
-
Excel VBA マクロ ある列の最終...
-
Excel VBAで、 ヘッダーへのセ...
-
DataGridViewの各セル幅を自由...
-
VBからEXCELのセルの値を取得す...
-
EXCELのVBA-フィルタ抽出後の...
-
VBAでセル同士を比較して色付け
-
Application.Matchで特定行の検索
おすすめ情報