ID非公開

2020/9/9 22:39

44回答

Excelですが

Excelですが B列に日を入れるのですが こうやって日の入力を端折ってくる奴いますよね? こちらで ポチポチ入力するか 関数いれたり Ctrl +Dしたり… ムカつきますよね VBAで なんとかならないですか?

画像

Excel187閲覧

ベストアンサー

0

日付入れないと上書き保存できない、ファイルを閉じられない、とかは出来ますけど、そのトリガーとなる条件を何にするかですね。 例)月は入力されてるけど日付が無い(逆も然り) 例)(画像で言うC列以降に入力があるのに月が無いor日が無いor両方無い

ID非公開

質問者

2020/9/10 4:26

そうすると全員のファイルに細工をしないといけないですよね? B列が空欄だったら 上から数字を持ってこい みたいなのは難しいでしょうか?

その他の回答(3件)

0

お仕事等で、使うときは、 ご意向のとおり、マクロが実行されるか どうか 確かめてください。 マクロボタン についての詳細、ファイルの全体的な状況等は、回答しておりませんので、必要時はコメントください。 【概要】 会社の各様式等が 変更できない場合・・ ・・詰まる所、こっちで「何とかせにゃならん」の、ときを想定。 「1」「1日」混在を 想定・・ ・・最初に すべて 数字のみに しておく。 ・・・→ マクロ Sub 日を取り除く() 「10」を「1o」等の タイプミス を 想定。 「12」を「122」等の タイプミス で 数字が 3桁以上になっているのを 想定。 【1】 マクロ Sub 日を取り除く() を実行して、 あえて、日付欄を 数字のみにする。 【2】 マクロ Sub 日を付ける() を実行して、 あらためて、「日」を付ける。 【 マクロボタン推奨 】 日付欄に「1o」等の場合、本人に確認をしてから 手入力かと考えます。マクロの画面(VBE)を開いて、手入力をすると、コードに 打ち込んでしまう惧れがありますので、マクロの画面(VBE)を開かずに、マクロを実行できる所の、マクロボタン、推奨です。 マクロ有効ファイル の マクロボタンを 普通のExcel ファイルに コピー・貼り付けで、普通のExcel ファイル を マクロで操作可能です。 このとき、双方の ファイルが 開かれている状態で マクロボタンを使ってください。 Sub 日を取り除く() On Error GoTo 100 Dim UpR As Long UpR = Cells(Rows.Count, "B").End(xlUp).Row '「日」を取り除く Dim i As Long For i = 2 To UpR Cells(i, "B").Select Dim AV As String AV = ActiveCell.Value If Cells(i, "B").Value <> "" And _ Right(AV, 1) = "日" Then Cells(i, "B").Value = Replace(AV, "日", "") End If Next i '「日」を取り除いて、日付欄が3文字以上なら ' 「NG!」と表示し、プログラム終わる。 Dim i2 As Long For i2 = 2 To UpR Cells(i2, "B").Select Dim AV2 As String AV2 = ActiveCell.Value If Len(AV2) > 2 Then MsgBox "NG!" Exit Sub End If Next i2 '「日」を取り除いても、 ' まだ末尾が 数値以外 のときは「NG!」と表示し、 ' プログラム 終わる。 Dim i3 As Long For i3 = 2 To UpR Cells(i3, "B").Select Dim AV3 As String AV3 = ActiveCell.Value If AV3 <> "" And IsNumeric(AV3) = False Then MsgBox "NG!" Exit Sub End If Next i3 Exit Sub 100: MsgBox "NGあり。" End Sub Sub 日を付ける() On Error GoTo 100 Dim UpR As Long UpR = Cells(Rows.Count, "B").End(xlUp).Row Dim i As Long For i = 2 To UpR Cells(i, "B").Select Dim B1 As Long B1 = Cells(i, "B").Value Dim Nu1 As Boolean Nu1 = IsNumeric(B1) If Nu1 = True And B1 > 0 Then Cells(i, "B").Value = B1 & "日" End If Next i Exit Sub 100: MsgBox "NGあり。" End Sub

1

こんな感じでは? Private Sub Worksheet_Change(ByVal Target As Range) Dim msg As Long, rng As Range If Target.CountLarge > 1 Then Exit Sub If Target.Column <> 2 Then Exit Sub If Target.Offset(-1) <> "" Then Exit Sub If Target.End(xlUp).Address = "$B$1" Then Exit Sub Set rng = Range(Target.End(xlUp), Target.Offset(-1)) msg = MsgBox("埋める?", vbYesNo) If msg = vbYes Then rng.FillDown Else End If End Sub

1人がナイス!しています

ID非公開

質問者

2020/9/13 8:32

返信ありがとうございます どうやって つかうのですか?

0

C列以降の入力規則で「A列からB列に空欄がない」ってしてやればいいんですよ。それで警告メッセージとして「日付はちゃんと入れろや」って出す。VBAで細工するよりずっと簡単。

ID非公開

質問者

2020/9/10 7:32

目上の頭ハゲてる人に警告が出るファイルなんて渡したら 余計ハゲてしまいます