スポンサーサイト 


上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

--/--/--

Category: スポンサー広告

TB: --  /  CM: --

top △

CSVの自力解釈 


CSV 云々に関しては、過去記事「テキストファイル(CSV等)の項目変換」とか・・・
処理内容については細かく記述してませんでしたね。

まぁ、あのツールもいろんなパターンを処理しきれているわけでもないので・・・
ソコソコ使ってみて、使えるようなら使うという事で・・・

今回、関数として作成したので、
・そのままでも・・・
・部分的にでも・・・

1行だけでも、複数行でもソコソコ処理できているんじゃないかな・・・と思ってみたり
内部の処理パターンは2種で
・Split で分けながら " " で囲まれた中での改行判別・・・とか
・InStr を多用して、文字列を切り出していく・・・とか

Private Function PartsInLines(sBuf As String, Optional sSep As String = ",") As Variant

っていう主処理部分に皮をかぶせて
Public Function PartsInLinesCSV(sBuf As String) As Variant
  PartsInLinesCSV = PartsInLines(sBuf)
End Function

Public Function PartsInLinesTAB(sBuf As String) As Variant
  PartsInLinesTAB = PartsInLines(sBuf, vbTab)
End Function

Public Function PartsInLinesSPACE(sBuf As String) As Variant
  PartsInLinesSPACE = PartsInLines(sBuf, " ")
End Function

これの呼び出し方は、(以下は Excel での例ですが、Access でも・・・)
(ソコソコの大きさのファイルなら以下で大丈夫だと思います)
Public Sub testReadGet()
  Dim ffn As Integer
  Dim v As Variant
  Dim btBuf() As Byte, sBuf As String
  Dim i As Long, j As Long

  ffn = FreeFile()
  Open ThisWorkbook.Path & "\ファイル名.csv" For Binary As #ffn
  ReDim btBuf(1 To LOF(ffn))
  Get #ffn, , btBuf
  Close #ffn
  sBuf = StrConv(btBuf, vbUnicode)

  v = PartsInLinesCSV(sBuf)
  Debug.Print sBuf
  For i = LBound(v) To UBound(v)
    For j = LBound(v(i)) To UBound(v(i))
      Debug.Print i; "."; j; " > "; v(i)(j)
    Next
  Next
End Sub

ファイルがかなり大きくて、1行ずつの処理が良いなら
Public Sub testReadLine()
  Dim ffn As Integer
  Dim v As Variant
  Dim sBuf As String
  Dim i As Long, j As Long

  ffn = FreeFile()
  Open ThisWorkbook.Path & "\ファイル名.csv" For Input As #ffn
  While (Not EOF(ffn))
    Line Input #ffn, sBuf

    v = PartsInLinesCSV(sBuf)
    Debug.Print sBuf
    For i = LBound(v) To UBound(v)
      For j = LBound(v(i)) To UBound(v(i))
        Debug.Print i; "."; j; " > "; v(i)(j)
      Next
    Next
  Wend
  Close #ffn
End Sub

    For i = LBound(v) To UBound(v)
部分は、1行分しか解釈させていないので v(0) 固定でも・・・
でも、でも・・・解釈できない場合は、空配列を返すので、固定はまずいかも・・・
戻り値は、Variant の配列で
・UBound(v)+1 で何行ありますよ( LBound(v) は 0 なんだけど一応・・・・)
・で、v(i)(0 ~ xx) がその行で切り出した項目(文字列 String で返します)
ってなものになってます。

仕様という程のものでは・・・・以下を処理します。
区切りを , とした場合

・文字列の囲みは、 " " および ' ' を自動認識
 また、囲みの文字が抜き出した文字列内にあったら、2個→1個に
"A,BC""DEF",'a,bc''def',1234 とか "A,BC""DEF" , 'a,bc''def' , 1234

(0)A,BC"DEF
(1)a,bc'def
(2)1234

・文字列の囲み以外の " および ' はそのまま
"A,B''C""DEF",'a,b""c''def',1234 とか "A,B''C""DEF" , 'a,b""c''def' , 1234

(0)A,B''C"DEF
(1)a,b""c'def
(2)1234

・囲み文字内の改行は項目内の文字列に入れる
・各行の項目数が違っていても合わせる事はしない
・項目は全て文字列として返す
 
Split を使った記述

Split の使い方

Split を使う時には、Split(文字列, 区切り文字) として良く使いますが、第3引数を使ってみます。
以下の様に第3引数に2を指定してみると
Public Sub test()
  Dim sA() As String
  Dim s As String

  s = "1,2,3,4,5"
  Debug.Print s
  While (Len(s) > 0)
    sA = Split(s, ",", 2)
    If (UBound(sA) = 0) Then
      s = ""
    Else
      s = sA(1)
    End If
    Debug.Print sA(0), "残> "; s
  Wend
End Sub
的な記述が出来、出力は以下の様になります
1,2,3,4,5
1  残> 2,3,4,5
2  残> 3,4,5
3  残> 4,5
4  残> 5
5  残>

区切り文字で1つずつ処理するのには便利なものかもしれません。
ただ、この方法でグルグル処理するものと、
一気に配列にしてから配列をグルグル処理するのと、どちらが速そう・・・ですかね

Split を使ったやり方では、与えられた文字列を vbCrLf で全部を配列化します。
配列にしたものを、さらに区切り文字で Split したものを処理していきます。
細かく説明するのはしんどいので・・・・割愛します。
全体記述は以下になります。
Public Function PartsInLinesCSV(sBuf As String) As Variant
  PartsInLinesCSV = PartsInLines(sBuf)
End Function

Public Function PartsInLinesTAB(sBuf As String) As Variant
  PartsInLinesTAB = PartsInLines(sBuf, vbTab)
End Function

Public Function PartsInLinesSPACE(sBuf As String) As Variant
  PartsInLinesSPACE = PartsInLines(sBuf, " ")
End Function

Private Function PartsInLines(sBuf As String, Optional sSep As String = ",") As Variant
  Dim dic As Object
  Dim vBuf As Variant, v As Variant, sA() As String
  Dim vR As Variant
  Dim sS As String, s As String
  Dim i As Long
  Dim bFirst As Boolean, bContinue As Boolean
  Const CMOJI As String = """'"

  Set dic = CreateObject("Scripting.Dictionary")
  vR = Array()
  vBuf = Split(sBuf, vbCrLf)
  For i = UBound(vBuf) To 0 Step -1
    If (Len(vBuf(i)) > 0) Then Exit For
  Next
  If ((i >= 0) And (i <> UBound(vBuf))) Then
    ReDim Preserve vBuf(i)
  End If
  bContinue = False
  For Each v In vBuf
    sA = Split(v, sSep)
    i = 0
    If (UBound(sA) < i) Then
      If (bContinue) Then sS = sS & vbCrLf
    Else
      bFirst = Not bContinue
      While (i <= UBound(sA))
        If (bFirst) Then
          sS = LTrim(sA(i))
          If ((Len(sS) = 0) Or (InStr(CMOJI, Left(sS, 1)) = 0)) Then
            dic(dic.Count) = RTrim(sS)
            sS = ""
          End If
        ElseIf (bContinue) Then
          sS = sS & vbCrLf & sA(i)
          bContinue = False
        Else
          sS = sS & sSep & sA(i)
        End If
        If (Len(sS) > 0) Then
          s = Left(sS, 1)
          If (((Len(sS) - Len(Replace(sS, s, ""))) Mod 2) = 0) Then
            sS = Left(sS, InStrRev(sS, s) - 1)
            dic(dic.Count) = Replace(Mid(sS, 2), s & s, s)
            bFirst = True
          Else
            bFirst = False
          End If
        End If
        i = i + 1
      Wend
      If (bFirst) Then
        If (dic.Count > 0) Then
          ReDim Preserve vR(UBound(vR) + 1)
          vR(UBound(vR)) = dic.Items
          dic.RemoveAll
        End If
      End If
      bContinue = Not bFirst
    End If
  Next
  Set dic = Nothing
  PartsInLines = vR
End Function


InStr を多用した記述

Split は使わないで InStr を多用して、どの文字を探している状態なのか・・・という処理に
これをすると、項目内に現れるかもしれない vbCrLf(改行コード)があろうがお構いなし・・・
これも、細かく説明するのはしんどいので・・・・割愛します。
全体記述は以下になります。
Public Function PartsInLinesCSV2(sBuf As String) As Variant
  PartsInLinesCSV2 = PartsInLines2(sBuf)
End Function

Public Function PartsInLinesTAB2(sBuf As String) As Variant
  PartsInLinesTAB2 = PartsInLines2(sBuf, vbTab)
End Function

Public Function PartsInLinesSPACE2(sBuf As String) As Variant
  PartsInLinesSPACE2 = PartsInLines2(sBuf, " ")
End Function

Private Function PartsInLines2(ByVal sBuf As String, Optional sSep As String = ",") As Variant
  Dim dic As Object
  Dim vR As Variant
  Dim sS As String, s As String
  Dim iPos As Long, jPos As Long, kPos As Long
  Const CMOJI As String = """'"
  Const CSEP As String = " "

  Set dic = CreateObject("Scripting.Dictionary")
  vR = Array()
  sBuf = sBuf & vbCrLf
  iPos = 1
  kPos = 0
  Do While (iPos > 0)
    jPos = iPos
    Do While (jPos <= Len(sBuf))
      If (Mid(sBuf, jPos, Len(vbCrLf)) <> vbCrLf) Then Exit Do
      jPos = jPos + Len(vbCrLf)
    Loop
    If (iPos <> jPos) Then
      If (dic.Count > 0) Then
        ReDim Preserve vR(UBound(vR) + 1)
        vR(UBound(vR)) = dic.Items
        dic.RemoveAll
      End If
    End If
    If (jPos > Len(sBuf)) Then Exit Do
    iPos = jPos
    If (kPos < iPos) Then kPos = InStr(iPos, sBuf, vbCrLf)
    If (sSep <> CSEP) Then
      While (Mid(sBuf, iPos, 1) = " ")
        iPos = iPos + 1
      Wend
    End If
    s = Mid(sBuf, iPos, 1)
    If (InStr(CMOJI, s) > 0) Then
      jPos = iPos
      Do
        jPos = InStr(jPos + 1, sBuf, s) + 1
      Loop While ((jPos <> 1) And (Mid(sBuf, jPos, 1) = s))
      If (jPos = 1) Then Exit Do
      sS = Mid(sBuf, iPos + 1, jPos - iPos - 2)
      sS = Replace(sS, s & s, s)
      If (Mid(sBuf, jPos, 1) = sSep) Then
        jPos = jPos + 1
      Else
        kPos = InStr(jPos, sBuf, vbCrLf)
        jPos = InStr(jPos, sBuf, sSep)
        If ((jPos = 0) Or (kPos < jPos)) Then
          jPos = kPos
        Else
          jPos = jPos + 1
        End If
      End If
    Else
      jPos = InStr(iPos, sBuf, sSep)
      If ((jPos = 0) Or (kPos < jPos)) Then jPos = kPos
      sS = RTrim(Mid(sBuf, iPos, jPos - iPos))
      If (jPos <> kPos) Then jPos = jPos + 1
    End If
    dic(dic.Count) = sS
    iPos = jPos
  Loop
  Set dic = Nothing
  PartsInLines2 = vR
End Function

 
※ Split の方法、InStr の方法とも、1行内の項目を切り出した時の置き場として
Dictionary の Item を利用しています。
CreateObject 出来ない環境では、その部分を書き換えてください。


以下は Excel での例になりますが、
読み込んだ csv ファイル「T1.csv」の内容を、「test.accdb」のテーブル「T1」に追加するものになります。
csv 1行目には項目名があり、この項目名はテーブル「T1」のフィールド名と同じ

Public Sub testReadWrite()
  Dim cn As Object
  Dim rs As Object
  Dim ffn As Integer
  Dim vA As Variant, vB As Variant, v As Variant
  Dim btBuf() As Byte, sBuf As String
  Dim i As Long, j As Long

  ffn = FreeFile()
  Open ThisWorkbook.Path & "\T1.csv" For Binary As #ffn
  ReDim btBuf(1 To LOF(ffn))
  Get #ffn, , btBuf
  Close #ffn
  sBuf = StrConv(btBuf, vbUnicode)

  v = PartsInLinesCSV(sBuf)

  Set cn = CreateObject("ADODB.Connection")
  cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" _
    & "Data Source=" & ThisWorkbook.Path & "\test.accdb;"
  Set rs = CreateObject("ADODB.Recordset")
  rs.Open "T1", cn, 0, 3

  vA = v(LBound(v))
  For i = LBound(v) + 1 To UBound(v)
    rs.AddNew
    For j = LBound(vA) To UBound(vA)
      Select Case vA(j)
        Case "an"
        Case Else
          rs(vA(j)) = IIf(Len(v(i)(j)) > 0, v(i)(j), Null)
      End Select
    Next
    rs.Update
  Next

  rs.Close: Set rs = Nothing
  cn.Close: Set cn = Nothing
End Sub


  vA = v(LBound(v))
  For i = LBound(v) + 1 To UBound(v)
    rs.AddNew
    For j = LBound(vA) To UBound(vA)
      Select Case vA(j)
        Case "an"
        Case Else
          rs(vA(j)) = IIf(Len(v(i)(j)) > 0, v(i)(j), Null)
      End Select
    Next
    rs.Update
  Next
この部分は、項目「an」は設定しないので、除外しながら追加していくものになります。
設定する際には、文字列長が 0 なら Null とするように・・・

Null にするものは無いし、除外する項目もない・・・なら、以下でも
  vA = v(LBound(v))
  For i = LBound(v) + 1 To UBound(v)
    rs.AddNew vA, v(i)
  Next

また、項目1つ目が "え" の次の行だけを追加したいのなら、以下のような感じに
(csv をSQLで取得しても、次の行のもの・・・これ、結構しんどいですね)
  vA = v(LBound(v))
  i = LBound(v) + 1
  bOk = False
  While (i <= UBound(v))
    If (bOk) Then rs.AddNew vA, v(i)
    bOk = v(i)(0) = "え"
    i = i + 1
  Wend

Excel での記述を例にしましたが、Access で使う時でも、変更はそうありません。


今回、サンプルファイルはありません。

なお、上記記述に不具合あっても私は責任取れません。
自己責任にてお願いします。


※ 既に csv 解釈ツールがあるのなら、そちらを使った方が・・・
また、汎用的な処理ではなく専用にすれば、記述量は減ると思います。

ここの記述は危ない・・・・
こんな方法が良い・・・・ 等々、教えてください
関連記事

2015/03/06

Category: 関数を作ってみる

TB: --  /  CM: 0

top △

この記事に対するコメント

top △

コメントの投稿

Secret

top △


上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。