excel vba 一番効率の良い方法を教えてください。

質問

こんにちは。よろしければ教えてください。

ＶＢＡで、テキストデータから読み込んだ日付「20080825」を、
エクセルシートに貼り付ける際（又は貼り付けた後）に、
「2008/08/25」と表示すると同時に「日付」として認識できる形
にしたいのです。（つまりシリアル値に変換したいということに
なるのかな？）

○読み込むデータは８ケタの数値です。
○当然ながら、セル１つにつき１つの日付です。
○データが多いので、一つ一つ変換すると時間がかかります。
　　（しかしこの方法しか思いつきません；）
○ＶＢＡでもワークシート関数でも…方法は問いません。

一番適している方法を教えてください。
よろしくお願い致します。

回答No.6

KenKen_SP · ベストアンサー

こんにちは。#3 です。

TextToColumns を使った場合、行単位で見れば一行なのですが...

> '　（ですのでループを使うのは大変かと・・・）

そうですか？ むしろループを使った方がスッキリする気がしますよ。

Sub Sample1()

　　Const COL_ = "L:L,M:M,P:P,T:T,U:U,V:V,X:X"

　　Dim e As Variant
　　For Each e In Split(COL_, ",")
　　　　Range(e).TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, 5)
　　Next
　　With Range(COL_)
　　　　.Replace What:="0", Replacement:="", LookAt:=xlWhole
　　　　.NumberFormatLocal = "yyyy/mm/dd"
　　End With

End Sub

> 今度は「負の日付」に悩まされています。

日付計算をしないなら表示上の問題と割り切ってしまったら？
シリアル値には変換してませんが、表示形式で見た目は yyyy/mm/dd に
できますよ。

Sub Sample2()

　　With Range("L:L,M:M,P:P,T:T,U:U,V:V,X:X")
　　　　.Replace What:="0", Replacement:="", LookAt:=xlWhole
　　　　.NumberFormatLocal = "0000""/""00""/""00"
　　End With

End Sub

いずれも 20080825 や 18991231 のように元データが8桁前提です。

また、1900 年以前の日付があるのであれば、一括で何とかしようと
するのは乱暴ですよね。Excel のシリアル値は 1900/1/2 以降しか
扱えない。規定外のデータを扱う以上、当然誤変換の可能性があり
ますよね。

ならば、一つ一つセルのデータを見て（ループ処理）、シリアル値に
変換可能かどうか検証しながら変換しなければなりません。

補足

ありがとうございます！！
ご親切に教えていただいて（；_；）

列ごとにループすればいいんですね！
すごい！すっきりしました。

でも・・・
> また、1900 年以前の日付があるのであれば、一括で何とかしようと
するのは乱暴ですよね。・・・
そんなんですよね。表示上だけ…という訳にはいかないので
やはり１つ１つセルを見ていかないといけないのか…。
なかなか上手くいきませんね・・・。

今回の件、とても勉強になりました！
列ごとのループ、これからいろいろ使えそうです♪
本当にありがとうございました。

回答No.7

KenKen_SP

#3,6 です。連投すみません。補足しておきますね。

> > 今度は「負の日付」に悩まされています。

ワークシートでシリアル値で扱えない以上、#6 の Sample2 のように
表示上でごまかすしかないわけですよね。

ちなみに、VBA の Date(日付)型 の有効範囲は、

　　西暦100 年1月1日～西暦9999年12月31日までの日付と時刻

ですから、もし日数計算などが必要になったら VBA で計算すれば
良いでしょう。例えば、

　　A1 セルに 18991231（見た目は表示形式で 1899/12/31)
　　A2 セルに 19000105（見た目は表示形式で 1900/01/05)

とあるとき、この日数を求めるには

　　Dim d1 As Date
　　Dim d2 As Date

　　d1 = DateValue(Range("A1").Text)
　　d2 = DateValue(Range("A2").Text)

　　MsgBox CStr(d2 - d1)
　　' // または
　　MsgBox CStr(DateDiff("d", d1, d2))

といった感じ。

お礼

追記ありがとうございました！！

へぇ～。ＶＢＡとワークシートでは扱える日の有効範囲が違う
んですね。知らなかった。
負の日付を含む日数計算をしたければＶＢＡ内で処理すれば
良いということですね。
本当に勉強になります。
なぜそんなにお詳しいんですか？
何にも知らない私が恥ずかしいです。

今回の場合、計算をするのではなく、ただただ「日付を日付として」
表示させるというのが目的でして…。1900年以前に生まれた人をどう
処理するかは今後の検討課題となりそうです。

本当に助かりました。
ありがとうございました！！

回答No.5

imogasi

#4です
＞膨大なデータを一括で変換する方法を取り入れたいと思っております。
私のはヒントで、質問者は応用してもらえる力はあると思って書いた。
膨大なデータであるとは関係ない。ピントハズレの反応なので心配。
全データに渉って,例えば
For i=1 to 65536
Cells(i,"A")=処理
Next i
の処理の中で使えばよいのであって、私の回答の良否と関係ないはず。
全範囲指定＝書式設定
と１本で設定出来るのは、全範囲のセルの値が日付シリアル値になってからです。列の全セルの値が、日付シリアル値にするにはどうすればよいかを議論している段階です。
これをＶＢＡコード上、全範囲指定で１行で済ます方法はない。

補足

失礼しました！！
言葉足らずでしたね。反省。

とりあえず、現在下のような感じにしてみましたが、
今度は「負の日付」に悩まされています。
話せば長くなってしまうので割愛させていただきますが
「誕生日」データを取り込んだ時に、1900年以前の誕生日は
すべて「####…」になってしまうのです。
お力をお貸しねがえませんでしょうか。

○データは1000件程度です。
○「0」のときは消去します。
○表示形式は、月と日も２ケタに合わせたいです。
○Ｌ・Ｍ・Ｐ・Ｔ・Ｕ・Ｖ・Ｘの各列に日付が入っています。
　（ですのでループを使うのは大変かと・・・）

Range("L:L").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("M:M").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("P:P").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("T:T").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("U:U").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("V:V").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("X:X").TextToColumns DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True
Range("L:L,M:M,P:P,T:T,U:U,V:V,X:X").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.NumberFormatLocal = "yyyy/mm/dd"

↑見づらいですね・・・すみません・・・。

いかがなものでしょうか？？

回答No.4

imogasi

その日付データをセルにセットする直前に
Sub test01()
x = "20080825"
d = DateSerial(Mid(x, 1, 4), Mid(x, 5, 2), Mid(x, 7, 2))
MsgBox d
Cells(1, 1) = d
Cells(1, 1).NumberFormatLocal = "ggge年mm月dd日"
End Sub
を参考に加工してください。
Cells(1, 1).NumberFormatLocal = "ggge年mm月dd日"
はしなくても日付書式2008/08/25 になるようだ。
DateSerialは年、月、日の数字を指定するが(Mid(x, 1, 4), （本来文字列）のままでもよいようだ。

お礼

ご返答ありがとうございます！！
できれば膨大なデータを一括で変換する方法を取り入れたいと
思っております。
ですが、imogasiさんの案も今後の参考にさせていただきたいと
思います。
ありがとうございました。

回答No.3

KenKen_SP

こんにちは。

いろいろな方法があると思いますが...

◆ 関数による方法
数式　　=DATEVALUE(TEXT(A1,"0000-00-00"))

◆ VBA による方法

' // 関数による方法を応用します
Sub Sample1()
　　Dim d As Date
　　Dim r As Range
　　For Each r In Selection.Cells
　　　　If Len(r.Value) = 8 Then
　　　　　　On Error Resume Next
　　　　　　' // Cdate または DateValue
　　　　　　d = CDate(Format$(r.Value, "0000-00-00"))
　　　　　　If Not Err Then
　　　　　　　　r.Value = d
　　　　　　End If
　　　　　　On Error GoTo 0
　　　　End If
　　Next
End Sub

' // #1ご回答の区切り文字を使った方法
Sub Sample2()
　　Range("A1:A5000").TextToColumns DataType:=xlDelimited, FieldInfo:=Array(1, 5)
End Sub

お礼

ご返答ありがとうございます！！
同じセルに変換した値を代入したいので、
やはり関数は適してないのでしょうね。
LOVE-UNIさんにも教えて頂いた「TextToColumns」を使おうと
しているところです。
他の案も参考にさせていただきますね♪
ありがとうございました。

回答No.2

xls88

試しに下記のようなマクロを組んでみました。
該当セル範囲をループするように編集すれば使えると思います。
>○読み込むデータは８ケタの数値です。
上記、必須条件です。
良ければ試しに使ってみてください。

Sub test()
　　Dim mydata As String
　　Dim myvar As Variant

　　mydata = ActiveCell.Value
　　myvar = Array(Left(mydata, 4), Mid(mydata, 3, 2), Right(mydata, 2))
　　With ActiveCell
　　　　.Value = myvar(0) & "/" & myvar(1) & "/" & myvar(2)
　　　　.NumberFormatLocal = "ggge年mm月dd日"
　　End With
End Sub

お礼

ご返答ありがとうございます！！
参考にさせていただきます。

回答No.1

love-uni

区切り位置を使う方法(文字列をシリアル値に変換)が簡単だと思います。

詳細は以下を参考にしてください。

参考URL：

http://www.eurus.dti.ne.jp/~yoneyama/Excel/hiduke.htm

お礼

おお！すごい！こんなことができるとは知りませんでした。
これをマクロに取り入れることはできるんですかねー？？
ちょっと調べてみます！！