[[20201231083919]] 『8桁数値を自動で日付に変換』(minoru) >>BOT

[ 初めての方へ | 一覧(最新更新順) |

| 全文検索 | 過去ログ ]

 

『8桁数値を自動で日付に変換』(minoru)

お世話になります。

A列は200行あります。
入力後の区切りウイザード使用や、別列に関数表示ではなく
A1セルに 20210101 半角8桁数値が入力され
Enterキーや右矢印で、A1セルの値が確定した時点で
A1セルに、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

A1にカーソルがある状態でマクロ実行で日付に
変換できましたが、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

稲葉様 返答ありがとうございます。
下記のコードで実行すると、カーソルが動いた先のセルが
ActiveCellになり、日付表示されますが
入力したセルの値は変化しませんでした。

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


まず、
ActivecellをTargetに変更して、 で

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


http://officetanaka.net/excel/vba/beginner/11.htm
 これを勧める。
(じじ) 2020/12/31(木) 23:11

 自分でコード書いたんじゃないのかな?
 じじさんの言うとおり、変数宣言強制してみると何が間違っているかわかると思いますよ
(稲葉) 2021/01/01(金) 06:59

元ネタは↓ですかね。
https://www.relief.jp/docs/excel-vba-8-digit-number-to-date.html

あと、「ここでデバックしました」とのことですが、正確には(実行時エラーが発生して)デバッグするか確認画面が出てきたということです。
実際のエラーメッセージが提示されていないので想像ですが、Targetが複数セルになっていたので、String型に格納できず、型が合わないというメッセージが出てきたんじゃないですか?

(もこな2) 2021/01/01(金) 12:33


 >.Activecell を Target に変更
 >         TargetCell

 になってますけど。

 >With TargetCell

(チオチモリン) 2021/01/01(金) 12:56


セルの書式設定を
####"年"##"月"##"日"
とすれば同様の結果になりますが、これではダメということでしょうか?
(ななし) 2021/01/01(金) 20:06

見た目だけ変わればよいのであれば、ななしさんのアイデアのほうが良いかもですが、そもそもを日付型に変換したいのであれば、こんな感じでは?

   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

表示形式を日付型に変えたセルに、再度数値を入力しようとするとマズイですけど・・・

(もこな2) 2021/01/02(土) 10:37


 >表示形式を日付型に変えたセルに、再度数値を入力しようとするとマズイですけど・・・
 どうせイベント使ってるなら、日付型以外が入力されたら、書式設定を標準に変えちまえばいいんでないですけ?
(稲葉) 2021/01/02(土) 22:00

>日付型以外が入力されたら
そもそも8桁の数字が日付型以外なので、私には上手い条件分岐が思いつかないです。

ちなみに、手元の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

(もこな2) 2021/01/03(日) 03:55


 Value2 と言うプロパティがありますけど・・

(半平太) 2021/01/03(日) 10:01


> Value2 と言うプロパティがありますけど・・
なるほどうまくいきました。ご指摘ありがとうございます。

どうもバズしまくってますね・・・スレ汚し失礼しました。

(もこな2) 2021/01/03(日) 10:59


稲葉様
じじ様
もこな2様
半平太様
チオチモリン様
ななし様

お世話になります、正月中に自宅PC開けず、
仕事始めで業務PC開いたところ、多数のご返答があり、誠にありがとうございます。
全部読みきれておりませんので不明点、疑問点はまた質問したいと存じます。
投稿したコードは、なんとなく意味は判るのでNETで検索したものを使用しておりました。
 返答が遅くなりすみませんでした。
 また、よろしくお願いします。

(minoru) 2021/01/05(火) 16:20


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.