0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

CSVデータの日付データのみ別のフォーマットに変換する

Last updated at Posted at 2021-06-27

■経緯

 ・受領したCSVデータの日付データが一般的な形式になっておらず、データインポート後に、日付データがリセットされる。
 ・excelでの変換を試みたが、インポート時に一部正しく表示されない箇所があった、
  また日付データ変換後に保存するとファイルの形式が変わってしまいデータインポートの段階で認識されなくなった。
 ※実際にはこんな事が起こるのはレアケースだと思いますが、文字列変換しているメソッド関数(TransChk)を修正すれば他に使い道があるかも知れませんので参考までに公開致します。
※6/28:やりたいことが少し違っていたためソース(テストデータ)を修正しました。
  変更前のデータで、区切りのスペースと数値の十の位がスペースが連続しスペースが複数含まれていた。
  変更後の日時がゼロパディング(zero padding)されたいた。
 ※6/30:追記
  "PM"や、”AAAPM"等の文字列の場合に誤変換されてしまうため
  STS_SEARCHの箇所で適度に判定処理を入れてください。

■環境:

 ・Excel 2019 64bit

■やりたいこと:

・CSVデータ(テキスト)で、ダブルクォーテーション(”)くくりの中で日付の文字列のみ、一般的なデータ形式に変換する。
〇変更前
 "6 13 2021 8:00AM"
 ↓
〇変更後
 "2020-06-13 8:00:00"

■VBA環境で実装

 ・メイン処理と、サブに分ける。サブ側の処理は全てクラスでまとめる。
 ・1機能を1関数で実装する。
 ・文字列の変換はステートマシンを利用して実装する。
  以下の処理もステートマシンの実装で対応する。
  ①ダブルクォーテーション(”)が奇数個と偶数個の箇所があるので、奇数の場合は一度変換した後に、
   最初のダブルクォーテーション(”)をキャンセルしてもう一度変換処理を実施する
  ②文字列を変換すると文字最大数が変化するので、変換後は一旦終了して、変換後から再度変換処理を行う

■その他注意事項

 ・確認は下記テストデータで確認
  それ以外のデータ(パターン)は未確認。
 ・コードはVBAにモジュール、クラスに適宜張り付けて使用。
  ※モジュール側にクラスのコードを貼り付けても正常に動作しないため

■コード

Module1.vba
Sub Sample()
    Dim text As String
    Dim p As Class1
    Dim oddflg As Boolean: oddflg = False
    Open "C:\test.txt" For Input As #1
    Do Until EOF(1)
        Set p = New Class1
        Line Input #1, text '一行ずつ読み込む
        p.DataInitial (text)
        Debug.Print p.Trans()
    Loop
    Close #1
End Sub
Class1.vba
Option Explicit
' メンバ変数
Public odd As Boolean
Private data As String
Private length As Long
Private hosei As Long
Private kaisi As Long
Const STS_ODDINI = 11
Const STS_INI = 1
Const STS_SEARCH = 2
Const STS_RBOOT = 3
Const STS_END = 4
Public Function DataInitial(inData As String)
    data = inData
    length = Len(data)
    odd = oddchekc
End Function
Public Function Trans() As String
    Dim status_id As Integer: status_id = STS_INI
    Dim serch As Long: serch = 1
    hosei = 0
    Trans = data
    Do
        If status_id = STS_RBOOT Then status_id = STS_INI '再投入(変換後のズレ対応)
        Trans = TransChk(status_id, serch, Trans)
        If status_id = STS_END And odd Then
            status_id = STS_ODDINI ''再投入(奇数文字のズレ対応)
            odd = False
        End If
    Loop While status_id <> STS_END
End Function
Private Function TransChk(status_id As Integer, serch As Long, Trans As String) As String
    Dim i As Long
    Dim chk1 As String
    Dim chk2 As String
    Dim temp As String
    TransChk = Trans
    For i = serch To length
        temp = Mid(Trans, i, 1)
        Select Case status_id
        Case STS_ODDINI
            If temp = """" Then
                status_id = STS_INI
            End If
        Case STS_INI
            If temp = """" Then
                status_id = STS_SEARCH
                kaisi = i
            End If
        Case STS_SEARCH
            If temp = """" Then
                chk1 = Mid(TransChk, i - 2, 1)
                chk2 = Mid(TransChk, i - 1, 1)
                If chk1 = "A" And chk2 = "M" Then
                    TransChk = TransExe(Trans, i, False)
                    serch = i + hosei + 1
                    hosei = 0
                    status_id = STS_RBOOT
                    i = length
                ElseIf chk1 = "P" And chk2 = "M" Then
                    TransChk = TransExe(Trans, i, True)
                    serch = i + hosei + 1
                    hosei = 0
                    status_id = STS_RBOOT
                    i = length
                Else
                    status_id = STS_INI
                End If
            End If
        End Select
    Next i
    If status_id <> STS_RBOOT Then
        status_id = STS_END
    End If
End Function
Private Function TransExe(inData As String, i As Long, flg As Boolean) As String
    Dim j As Long
    Dim chk As String
    Dim prechk As String
    Dim tmp As Variant
    Dim tmp_time As Variant
    Dim timenum As Long
    TransExe = Mid(inData, 1, kaisi - 1)
    prechk = Mid(inData, kaisi + 1, i - kaisi - 1)
    chk = Application.WorksheetFunction.Trim(prechk) '"6 13 2021  8:00AM"->"6 13 2021 8:00AM"
    tmp = Split(chk, " ") 'Split("6 13 2021 8:00AM", " ")->tmp(0)="6",tmp(1)="13",tmp(2)="2021"tmp(3)="8:00AM"
    chk = """"
    chk = chk + Trim(tmp(2)) + "-" + Trim(tmp(0)) + "-" + Trim(tmp(1))
    tmp_time = Split(tmp(3), ":")
    timenum = Val(tmp_time(0))
    If timenum < 9 Then
        If flg Then
            chk = chk + " " + CStr(timenum + 12) + ":"
        Else
            chk = chk + " 0" + CStr(timenum) + ":"
        End If
    Else
        chk = chk + " " + Trim(tmp_time(0)) + ":"
    End If
    chk = chk + Left(Trim(tmp_time(1)), 2) + ":00" + """"
    
    hosei = Len(chk) - 2 - Len(prechk)
    TransExe = TransExe + chk + Mid(inData, i + 1, length - i)
    length = Len(TransExe)
End Function
Private Function oddchekc() As Boolean
    Dim temp As String
    Dim i As Long
    Dim count As Long: count = 0
    For i = 1 To length
        temp = Mid(data, i, 1)
        If temp = """" Then
            count = count + 1
        End If
    Next i
    If count Mod 2 = 0 Then
        oddchekc = False
    Else
        oddchekc = True
    End If
End Function

・テスト用のCSVデータ
https://github.com/katsunori-tanaka/awesome/blob/master/test.txt

■工数

 1Day

以上です、お疲れ様です。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?