[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『８桁数値を自動で日付に変換』（minoru）
お世話になります。
Ａ列は２００行あります。
入力後の区切りウイザード使用や、別列に関数表示ではなく
Ａ１セルに 20210101 半角８桁数値が入力され
Enterキーや右矢印で、Ａ１セルの値が確定した時点で
Ａ１セルに、2021年1月1日と日付で表示させたい。
よろしくお願いします。
＝＝試したこと＝＝
Sub アクティブセルの8桁の数字を日付にする_Format関数()
Dim org As String
Dim buf As String
With ActiveCell
org = .Value
If Len(org) = 8 Then
buf = Format(org, "@@@@/@@/@@")
If IsDate(buf) = True Then
.Value = buf
.NumberFormatLocal = "yyyy年m月d日"
End If ' IsDate
End If ' Len = 8
End With ' ActiveCell
End Sub
Ａ１にカーソルがある状態でマクロ実行で日付に
変換できましたが、Enterキーや→との組み合わせ方が
判りませんでした。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
＜ 使用 Excel：unknown、使用 OS：unknown ＞
worksheet_changeイベントがよろしいのではないでしょうか？ https://tonari-it.com/excel-vba-event-worksheet-change/
コードの中身ちゃんと見てないですが、Endのところにコメント入れるのわかりやすくていいですね （稲葉） 2020/12/31(木) 10:08
Private Sub Worksheet_Change(ByVal Target As Range)
Dim org As String Dim buf As String
With ActiveCell
org = .Value
If Len(org) = 8 Then
buf = Format(org, "@@@@/@@/@@")
If IsDate(buf) = True Then
.Value = buf
.NumberFormatLocal = "yyyy年m月d日"
End If ' IsDate
End If ' Len = 8
End With ' ActiveCell
End Sub
（minoru） 2020/12/31(木) 14:42
ActivecellをTargetに変更して、 複数セルが変更された場合の処理追加 https://www.moug.net/tech/exvba/0050063.html
書き戻す処理の前に、EnableEventをFalseにして、Trueに戻す https://tonari-it.com/excel-vba-event-change-enableevents/
を追加してください
（稲葉） 2020/12/31(木) 15:07
Private Sub Worksheet_Change(ByVal Target As Range)
Dim org As String
Dim buf As String
With TargetCell
org = .Value ←ここでデバックしました
変数の指定も変えるのでしょうか？
（minoru） 2020/12/31(木) 15:55
これを勧める。 （じじ） 2020/12/31(木) 23:11
自分でコード書いたんじゃないのかな？ じじさんの言うとおり、変数宣言強制してみると何が間違っているかわかると思いますよ （稲葉） 2021/01/01(金) 06:59
あと、「ここでデバックしました」とのことですが、正確には（実行時エラーが発生して）デバッグするか確認画面が出てきたということです。
実際のエラーメッセージが提示されていないので想像ですが、Targetが複数セルになっていたので、String型に格納できず、型が合わないというメッセージが出てきたんじゃないですか？
（もこな２） 2021/01/01(金) 12:33
>.Activecell を Target に変更 > TargetCell
になってますけど。
>With TargetCell
（チオチモリン） 2021/01/01(金) 12:56
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRNG As Range
Dim bufRNG As Range
Set bufRNG = Intersect(Range("A1:A100"), Target)
'▼書き換えがあったセルに対象のセル範囲が含まれていなければ、即終了
If bufRNG Is Nothing Then Exit Sub
'▼書き換えのあったセル、かつ、対象のセル範囲のものを一つずつ処理
Application.EnableEvents = False
For Each MyRNG In bufRNG
If IsNumeric(MyRNG.Value) Then
If Len(MyRNG.Value) = 8 Then
MyRNG.Value = Format(MyRNG.Value, "@@@@/@@/@@")
MyRNG.NumberFormatLocal = "yyyy年m月d日"
End If
End If
Next MyRNG
Application.EnableEvents = True
End Sub
表示形式を日付型に変えたセルに、再度数値を入力しようとするとマズイですけど・・・
（もこな２） 2021/01/02(土) 10:37
＞表示形式を日付型に変えたセルに、再度数値を入力しようとするとマズイですけど・・・ どうせイベント使ってるなら、日付型以外が入力されたら、書式設定を標準に変えちまえばいいんでないですけ？ （稲葉） 2021/01/02(土) 22:00
ちなみに、手元のExcel2007だと、日付型に変更したセルに「20200101」などとしてからMyRNG.Valueを取得しようとするところでオーバーフローになるんですよね。。。
（セルの表示は#######になってしまう）
苦肉の策として、無条件で標準に戻してから判定する例など。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRNG As Range
Dim bufRNG As Range
Set bufRNG = Intersect(Range("A1:A100"), Target)
If bufRNG Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each MyRNG In bufRNG
MyRNG.NumberFormatLocal = "G/標準"
If IsNumeric(MyRNG.Value) Then
If Len(MyRNG.Value) = 8 Then
MyRNG.Value = Format(MyRNG.Value, "@@@@/@@/@@")
MyRNG.NumberFormatLocal = "yyyy年m月d日"
End If
End If
Next MyRNG
Application.EnableEvents = True
End Sub
（もこな２） 2021/01/03(日) 03:55
Value2 と言うプロパティがありますけど・・
（半平太） 2021/01/03(日) 10:01
どうもバズしまくってますね・・・スレ汚し失礼しました。
（もこな２） 2021/01/03(日) 10:59
お世話になります、正月中に自宅ＰＣ開けず、
仕事始めで業務ＰＣ開いたところ、多数のご返答があり、誠にありがとうございます。
全部読みきれておりませんので不明点、疑問点はまた質問したいと存じます。
投稿したコードは、なんとなく意味は判るのでＮＥＴで検索したものを使用しておりました。
返答が遅くなりすみませんでした。
また、よろしくお願いします。
（minoru） 2021/01/05(火) 16:20
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.