Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3561 / 13644 ツリー ←次へ | 前へ→

【61422】CSVデータの日付変更 HAM 09/5/7(木) 14:52 質問[未読]
【61423】Re:CSVデータの日付変更 Jaka 09/5/7(木) 16:14 発言[未読]
【61426】Re:CSVデータの日付変更 HAM 09/5/7(木) 17:19 お礼[未読]
【61424】Re:CSVデータの日付変更 ひつまぶし 09/5/7(木) 16:37 回答[未読]
【61427】Re:CSVデータの日付変更 HAM 09/5/7(木) 17:19 お礼[未読]

【61422】CSVデータの日付変更
質問  HAM  - 09/5/7(木) 14:52 -

引用なし
パスワード
   いつも勉強させていただきありがとうございます。

CSVから読み込んだファイルにて
全てが文字列表記になっており
G列に210315や210501のように記載されています。
このG列に入っている値は必ず6桁です
平成21年3月15日という意味になるのですが
これを西暦表記の
2009/03/15に変更したく
下記のMacroを用意しました
これでも問題はないのですが
もっとうまく纏める方法があればと思いました。
ご教授お願い致します。

  With Range(Cells(1, 1), ActiveCell.SpecialCells(xlLastCell))
    .NumberFormat = "General"
    .FormulaLocal = .FormulaLocal
  End With
  Columns("G:G").Insert Shift:=xlToRight
  For R = 1 To Cells(Rows.Count, 8).End(xlUp).Row
    Cells(R, 7) = "=DATE(LEFT(RC[1],2)+1988,MID(RC[1],3,2),RIGHT(RC[1],2))"
  Next R
  Columns("G:G").Copy
  Columns("G:G").PasteSpecial Paste:=xlPasteValues
  Columns("H:H").Delete Shift:=xlToLeft

【61423】Re:CSVデータの日付変更
発言  Jaka  - 09/5/7(木) 16:14 -

引用なし
パスワード
     For R = 1 To Cells(Rows.Count, 7).End(xlUp).Row
    Cells(R, 7).Value = CDate("H" & Format(Cells(R, 7).Value, "00/00/00"))
  Next R

【61424】Re:CSVデータの日付変更
回答  ひつまぶし  - 09/5/7(木) 16:37 -

引用なし
パスワード
   まず、
数式をセットするのに、セル一つ一つセットする必要はありません。
範囲に対して一気に数式セットできます。

  Columns("G:G").Insert Shift:=xlToRight
  With Range("H1", Cells(Rows.Count, "H").End(xlUp)).Offset(, -1)
    .FormulaR1C1 = "=DATE(LEFT(RC[1],2)+1988,MID(RC[1],3,2),RIGHT(RC[1],2))"
    .Value = .Value
    '値のコピペの方が良ければ、
    '.Copy
    '.PasteSpecial xlPasteValues
  End With
  Columns("H:H").Delete Shift:=xlToLeft


ただ、作業列の挿入・削除がうっとうしいので、別案として、
最終的に数式を残さないのであれば、次のような関数を用意してしまっては如何でしょう。
(コード簡素化の為、再帰を利用してます。)

Function 西暦へ変換(ByVal arg As Variant) As Variant
Dim v As Variant
Dim i As Long, j As Long
If TypeOf arg Is Range Then arg = arg.Value
If IsArray(arg) Then
  ReDim v(1 To UBound(arg, 1), 1 To UBound(arg, 2))
  For i = 1 To UBound(arg, 1)
    For j = 1 To UBound(arg, 2)
      v(i, j) = 西暦へ変換(arg(i, j))
    Next
  Next
Else
  v = DateSerial(Left$(arg, 2) + 1988, Mid$(arg, 3, 2), Right$(arg, 2))
End If
西暦へ変換 = v
End Function

Sub 使用例()
With Range("G1", Range("G" & Rows.Count).End(xlUp))
  .Value = 西暦へ変換(.Value)
End With
End Sub

【61426】Re:CSVデータの日付変更
お礼  HAM  - 09/5/7(木) 17:19 -

引用なし
パスワード
   ▼Jaka さん:
たった3行で事足りることに
なんと無駄の多かったことか・・・
もういろいろとしょんぼりです
おかげで大変助かりましたありがとうございました。

【61427】Re:CSVデータの日付変更
お礼  HAM  - 09/5/7(木) 17:19 -

引用なし
パスワード
   ▼ひつまぶし さん:
このようにすっきりできるとは思いませんでした
数式すら満足に使えずに大変勉強になりました。
ありがとうございました。

3561 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free