■経緯
・受領した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にモジュール、クラスに適宜張り付けて使用。
※モジュール側にクラスのコードを貼り付けても正常に動作しないため
■コード
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
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
以上です、お疲れ様です。