Excel VBA質問箱 IV

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

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


14259 / 76734 ←次へ | 前へ→

【67974】Re:CSVの取込について
発言  Yuki  - 11/1/20(木) 10:30 -

引用なし
パスワード
   ▼なな さん:
>CSVを読取モードで開いて、データをシート1に読込むようマクロを組んでいますが、どうしても、問題が解決できず困っています
>
>CSV内のデータ
>"111","222","333","444","555"
>"666","7,77","888","999","10000"
>上記のようなcsvデータがあって、
>Splitでカンマの位置で分割して配列にしているのですが、
>そうすると
>
>下記の行の場合
>"666","7,77","888","999","10000"

過去に何回かありましたが。
参考にして下さい。
Option Explicit


Sub TEST_CSV_READ()
  Dim intFno   As Integer
  Dim strIFNm   As String
  Dim strOFNm   As String
  Dim bytBuf()  As Byte
  Dim vV     As Variant
  Dim vA     As Variant
  Dim vR     As Variant
  Dim sA     As String
  Dim i      As Long
  Dim j      As Long
  Dim x      As Long
  Dim y      As Long
  Dim eCol    As Long

'  InPut用CSVファイル
  strIFNm = "D:\Excel\Test1.csv"
  intFno = FreeFile
  
  Open strIFNm For Binary As #intFno
    ReDim bytBuf(LOF(intFno) - 1)
    Get #intFno, , bytBuf
  Close #intFno
  
  vV = StrConv(bytBuf, vbUnicode)
  vV = Split(vV, vbCrLf)
  
  ' 1行目がタイトル行で桁数をチェック
  eCol = UBound(Split(vV(0), ","))
  ' タイトル行が無い時は予め列数を固定して置く
'  eCol = 5 とかを 0 Baseで。
  
  ReDim vR(1 To UBound(vV), 1 To eCol + 1)
  
  For i = 1 To UBound(vV) - 1
    sA = Replace(vV(i), vbCrLf, "")
    If UBound(StrSplit(sA)) < eCol + 1 Then
      j = i
      Do While UBound(StrSplit(sA)) < eCol + 1
        j = j + 1
        sA = sA & Replace(vV(j), vbCrLf, "")
      Loop
      i = j
    Else
      sA = vV(i)
    End If
    vA = StrSplit(Replace(sA, vbCrLf, ""))
    x = x + 1
    For j = 1 To UBound(vA)
      vR(x, j) = vA(j)
    Next
  Next
  With Worksheets("Sheet1")
    .Cells.ClearContents
    .Range("A1").Resize(x, eCol + 1).Value = vR
  End With
End Sub

Function StrSplit(mStr As String) As Variant
  Dim strArys()  As String
  Dim strAry()  As String
  Dim strD    As String
  Dim varD()   As Variant
  Dim lngCnt   As Long
  Dim i      As Long

  strArys = Split(mStr, ",")
  For i = 0 To UBound(strArys)
    If strArys(i) Like "*""" Then
      ReDim Preserve strAry(lngCnt)
      strAry(lngCnt) = strArys(i)
      lngCnt = lngCnt + 1
    Else
      ReDim Preserve strAry(lngCnt)
      If strArys(i) Like """*" Then
        strAry(lngCnt) = strArys(i)
        Do While Not strArys(i) Like "*"""
          i = i + 1
          If UBound(strArys) < i Then Exit Do
          strAry(lngCnt) = strAry(lngCnt) & "," & strArys(i)
        Loop
      Else
        strAry(lngCnt) = strArys(i)
      End If
      lngCnt = lngCnt + 1
    End If

    strD = strAry(lngCnt - 1)
    ReDim Preserve varD(1 To lngCnt)
    If Left(strD, 1) = """" And Right(strD, 1) = """" Then
      varD(lngCnt) = Mid(strD, 2, Len(strD) - 2)
    Else
      varD(lngCnt) = strD
    End If
  Next
  StrSplit = varD
End Function

5 hits

【67957】CSVの取込について なな 11/1/19(水) 11:59 質問
【67958】Re:CSVの取込について Jaka 11/1/19(水) 13:08 発言
【67961】Re:CSVの取込について なな 11/1/19(水) 13:27 発言
【67973】Re:CSVの取込について SS 11/1/20(木) 9:12 発言
【67982】Re:CSVの取込について なな 11/1/21(金) 9:46 お礼
【67974】Re:CSVの取込について Yuki 11/1/20(木) 10:30 発言
【67983】Re:CSVの取込について なな 11/1/21(金) 9:51 お礼
【67975】Re:CSVの取込について kanabun 11/1/20(木) 10:50 発言
【67984】Re:CSVの取込について なな 11/1/21(金) 10:18 お礼
【67976】Re:CSVの取込について Hirofumi 11/1/20(木) 11:28 回答
【67985】Re:CSVの取込について なな 11/1/21(金) 10:22 お礼

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