プロが教える店舗&オフィスのセキュリティ対策術

"西暦 1933 年 6 月 20 日" のような日付をエクセルで1933/6/20のように取扱い可能なものに変換したいのですがよい方法がないでしょうか。

年と数字の間などの半角スペースなどが障害かと思います。

質問者からの補足コメント

  • 同様の項目が何百とならんでいるので一括して変換する方法を探しております。

      補足日時:2015/03/09 12:28
  • ありがとうございます。
    少し頑張ってみたのですが具体的にどうすればよいかまで教えていただけましたら助かります。

    No.2の回答に寄せられた補足コメントです。 補足日時:2015/03/09 14:38
  • ありがとうございました。年のフォントの問題か数式ではうまくいきませんでしたがマクロではできました。

    ただこの日付がいろいろなセルにあるのですが、選択したところのみを変換する、というふうにはできないでしょうか。

    No.5の回答に寄せられた補足コメントです。 補足日時:2015/03/09 18:08

A 回答 (6件)

こんばんは。



#5の回答者です。
>年のフォントの問題か数式ではうまくいきませんでしたがマクロではできました。
実は、私のところもそうだったのです。それで、年という文字を新たに入れ直したら、通ったのですが、大量だと大変ですね。

それで、マクロが設置できたのは、本当に、良かったなって思います。今回の方法は「正規表現(RegExp=Regular Expression)」というのですが、これが入れば、もう怖いものナシです。どんなものでも、数字を拾いだしてきます。後々で、修正するのが簡単なのです。欠点は、少し遅いということです。
どこの掲示板でも、「正規表現」を知っている人がいますから、こういう日付だと言えば、誰かが答えます。
.Pattern = ****** の部分を書き換えるだけで、ほとんど済ませられます。

>ただこの日付がいろいろなセルにあるのですが、選択したところのみを変換する、というふうにはできないでしょうか。

やっぱりそうなんだろうなって思いました。ふと、後で気になりました。
簡単に換えられます。

もしも、前のコードをそのまま使うならですが、以下をそのまま貼り付けてもよいです。
もともとは、実験的なものでしたから、今回のものが良ければ、そのまま、こちらに切り替えてください。

ただし、心のこりとしては、、平成・昭和・大正・明治の元号がついている場合と、それから、年号そのものがない場合は、対応出来ていません。必要な場合は、今のを元にして考えられると思います。それと注意点は、今のシステムを利用したものは、1900年以降になってしまいます。

変更点:
'-------------------------------------------
1.SUbの後の最初の名前を換えました。
2.3.「(コメント)ブロック」というのは、センテンスの先頭に「'(シングルクオート)」を書き入れただけです。むろん、削除してしまっても問題ないレベルです。
4.A1~A列のデータの終わりまでとあった所を、Selection.Cells に換えます。
セル上のみで、オートシェイプの上は、ダメです。
'-----------------------------------------------
2.3.を変えたことで、例えば、西暦があっても、なくても、1936年2月13日でも、1936・02・13 でも、西暦1936 年 2月13 日でも、数字の塊が、3つあれば、それを拾ってきます。


'//
Sub ChangingDate() '←名前は同じでなければなんでもよい
 Dim Matches
 Dim n As String
 Dim buf As String
 Dim c As Range
 With CreateObject("VBScript.RegExp")
  Application.ScreenUpdating = False
  For Each c In Selection.Cells '←このように書き換えるだけでよい。
   'If InStr(1, c.Text, "西暦") > 0 Then '←この制限を「'」でブロックします。
    n = c.Text
    .Pattern = "(\d{4})\D+(\d{1,2})\D+(\d{1,2})\D*"
    .Global = False
    Set Matches = .Execute(n)
    If Matches.Count > 0 Then
     With Matches(0).SubMatches
      If .Count = 3 Then
       buf = .Item(0) & "/" & .Item(1) & "/" & .Item(2)
       If IsDate(buf) Then
        c.Value = buf
        c.Value = c.Value
       End If
       buf = ""
      End If
     End With
    End If
   'End If  '←ここも「'」でブロックします。
  Next c
  Application.ScreenUpdating = True
 End With
End Sub
'//
    • good
    • 0
この回答へのお礼

完璧です。

ありがとうございました。

お礼日時:2015/03/10 05:35

#2の回答者です。



思いの他、この内容を書くのに手間取ってしまいました。
数式で可能なら、そちらをお勧めしますが、空白値が一定なら、それもよいかもしれませんが、こちらでは、思ったようには行かなかったのです。あえて、数字だけを取り出して、それを日付にさせるという方法を取ったのです。

>少し頑張ってみたのですが具体的にどうすればよいかまで教えていただけましたら助かります。

参考サイトは、以下にありますが、
インストラクターのネタ帳
Office 2013
http://www.relief.jp/itnote/archives/018317.php

Office 2010
http://www.relief.jp/itnote/archives/003623.php

ここに画像がでていますから、ここを参考にされても良いと思います。

・さらに簡単にマクロを取り付ける方法(一部、上記と重複します)
(1) 最初に開発タブがないはずですから、
  [ファイル]-[オプション]-[リボンのユーザー設定]
  右側の「リボンのユーザー設定」で、
  [✔]開発
  とチェックを入れてください。
(2)次に、 今使おうとしているシートを開いてください。
  右側のメニュー上部に[開発]という文字が見えるはずです。
  それをクリックして開いてください。
(3)リボンの中に、[挿入]という文字が見えましたら、そこをクリックして開けてください。
  一覧が出てきて、上のほうが、「フォームコントロール」です。
  その中で、左端の上が、「ボタン」ですから、それをクリックしてください。
  マウスカーソルが、+ に変わりますから、それでシート上でドラッグすると、ボタンが現れ
  [マクロの登録]というダイアログが出てきます。
(4) 「新規作成 」を選んで、クリックすると、新しい画面が出てきます。
-----------------------
Sub ボタン1_Click() 「添付画像」

End Sub
-----------------------
こんな風な文字がでていますから、Sub GetUrDate() と End Subを抜いた、言い換えると、2行目から最後の1つ手前の行までをコピーして、貼り付けます。

★(5) ★重要なポイントがひとつあります。
コードの中の9行目には、
For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
という項目が書かれています。
これは、A1~その列のデータがある最後までを指しています。
それを実際のデータに合わせるには、

For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
このA1の部分を書き換えなくてはなりません。

A列であれば、そのまま、行の始まりが、5行目なら、
For Each c In Range("A5", Cells(Rows.Count, "A").End(xlUp))
とすれば済みます。

B列でしたら、
For Each c In Range("B5", Cells(Rows.Count, "B").End(xlUp))
と、両方を直してます。

(6)後は、上になっている画面を閉じてしまって良いです。元のワークシートの画面に戻ります。

そして、ボタンを押したら、正しく設定されていたら、一瞬で終わってしまいます。

一応、ここまでですが、あまりマクロを搭載したブック(xlsmという拡張子に変わります)を望んでいない時があります。
'------------------------
今度は、マクロを取り去る方法ですが、
そのまま[保存]で、「拡張子を[xlsx]」をそのままでしようとすると、マクロをどうするか聞いてきます。

「次の機能はマクロなしのブックには保存できません。
・VBプロジェクト

マクロなしのブックとして保存する場合は、[はい]をクリックしてください。」
とありますから、「はい(y)」をクリッしても構いません。

保存する場合は、「拡張子を[xlsm]」にして、保存してあければよいです。

以上です。
「"西暦 1933 年 6 月 20 日"」の回答画像5
この回答への補足あり
    • good
    • 0

式でよろしければ



=DATEVALUE(SUBSTITUTE(SUBSTITUTE(A1," ",""),"西暦",""))

書式設定で日付に変更
(スペースは半角スペースを置換で無くしています。)

でも。
質問に書かれている「西暦 1933 年」の年がちょっと普通の文字コードと違うみたいなんですが、もしこの式で#VALUEになるなら、置換ダイアログを出し「年」を普通に入力したものと置換された方がいいかも。
    • good
    • 0

SUBSTITUTE関数のオンパレードで何とか・・・


B1: =DATEVALUE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1,"西暦 ","")," 年 ","/")," 月 ","/")," 日",""))

【独白】質問文中の「西暦 1933 年 6 月 20 日」の「年」のフォントが…?
「"西暦 1933 年 6 月 20 日"」の回答画像3
    • good
    • 0

こんにちは。



数式で頑張ろうとは思いましたが、思うようにいかないので、マクロに切り替えました。

これは、西暦と書かれてあるセルの文字列から、数字だけを抜き出すマクロです。
だから、数字以外の所に空白でも、何があっても、4桁の数字 1~2桁 1~2桁であるなら、
変換しますが、日付値でないものは、貼り付けられません。
例:不可:西暦2015,20,1 , 可:西暦 2010,12,   1

フォームコントロールのボタンのマクロに登録してあげるとよいです。
'//標準モジュールの利用を想定しています。
Sub GetUrDate()
 Dim Matches
 Dim n As String
 Dim buf As String
 Dim c As Range
 With CreateObject("VBScript.RegExp")
  'A列のA1から, 列のデータの最後まで。
  Application.ScreenUpdating = False
  For Each c In Range("A1", Cells(Rows.Count, "A").End(xlUp))
   If InStr(1, c.Text, "西暦") > 0 Then
    n = c.Text
    .Pattern = "(\d{4})\D+(\d{1,2})\D+(\d{1,2})\D*"
    .Global = False
    Set Matches = .Execute(n)
    If Matches.Count > 0 Then
     With Matches(0).SubMatches
      If .Count = 3 Then
       buf = .Item(0) & "/" & .Item(1) & "/" & .Item(2)
       If IsDate(buf) Then '日付値か確認
        c.Value = buf
        c.Value = c.Value
       End If
       buf = ""
      End If
     End With
    End If
   End If
  Next c
  Application.ScreenUpdating = True
 End With
End Sub
'//
この回答への補足あり
    • good
    • 0

エクセルやワードで「置換」を使えばできますよ。



例えば「西暦 1933 年 6 月 20 日」の”西暦 ”(西暦の後にスペースがあります)を””(スペースも何もなし)に置換すると「1933 年 6 月 20 日」に変換されます。

同様に” 年 ”(スペース+年+スペース)を”/”に置換すれば「1933/6 月 20 日」に変換されます。

これを繰り返せば「1933/6/20」になりますよ。

置換はエクセル2013なら「ホーム」の「検索と選択」にあります。


任意の文字を表すような記号が使えれば、一度にできるかもしれません。
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!