Excel VBA質問箱 IV

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

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


2444 / 13645 ツリー ←次へ | 前へ→

【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 お礼[未読]

【67957】CSVの取込について
質問  なな  - 11/1/19(水) 11:59 -

引用なし
パスワード
   CSVを読取モードで開いて、データをシート1に読込むようマクロを組んでいますが、どうしても、問題が解決できず困っています

CSV内のデータ
"111","222","333","444","555"
"666","7,77","888","999","10000"
上記のようなcsvデータがあって、
Splitでカンマの位置で分割して配列にしているのですが、
そうすると

下記の行の場合
"666","7,77","888","999","10000"

MySalesData(0)="666"
MySalesData(1)="7"
MySalesData(2)="77"
MySalesData(3)="888"
MySalesData(4)="999"
MySalesData(5)="10000"

となってしまいます
本当は

MySalesData(0)="666"
MySalesData(1)="7,77"
MySalesData(2)="888"
MySalesData(3)="999"
MySalesData(4)="10000"

というようにしたいのですが、
どのようにしたらよいのでしょうか?

どうかアドバイスをお願いします

現在のコード↓

Dim MyFSO As New filesystemobject
Dim MyTextFile As TextStream
Dim vntFileName As Variant
Dim vntGetFileName As Variant

Set MyTextFile = MyFSO.OpenTextFile(vntGetFileName, ForReading)
   Worksheets("シート1").Activate

   With MyTextFile
      .SkipLine
      Do Until .AtEndOfStream = True

       MySalesData = Split(Replace(.ReadLine, """", ""), ",")
        Cells(i,1).Value=MySalesData(0)
        Cells(i,2).Value=MySalesData(1)
        Cells(i,3).Value=MySalesData(2)
        Cells(i,4).Value=MySalesData(3)
        Cells(i,5).Value=MySalesData(4)
       
        i=i+1
     Loop
     .Close
   End With

【67958】Re:CSVの取込について
発言  Jaka  - 11/1/19(水) 13:08 -

引用なし
パスワード
   >CSV内のデータ
>"111","222","333","444","555"
>"666","7,77","888","999","10000"
>上記のようなcsvデータがあって、
>Splitでカンマの位置で分割して配列にしているのですが、

セルに
「"111"」と読み込みたいのでしょうか?(Wクォーテーション付き)
「111」それともこっち?

とりあえず過去ログ。
他にもたくさんあると思いますよ。

OpenTextFile
ht tp://www.vbalab.net/vbaqa/c-board.cgi?page=&no=5244&mode=tre&id=excel&cmd=jmp

input
注)Inputで読み込むと"  ああ  " など、両端のスペースがTrimされたようになる。
ht tp://www.vbalab.net/vbaqa/data/excel/log/tree_373.htm#1910
コピペの方法は、、
ht tp://www.vbalab.net/vbaqa/c-board.cgi?page=&no=2205&mode=one&id=&cmd=jmp

Dao(石鹸箱の記事番号2645)
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=2645;id=

【67961】Re:CSVの取込について
発言  なな  - 11/1/19(水) 13:27 -

引用なし
パスワード
   ▼Jaka さん:

返信ありがとうございます

「111」です
 Wクォーテーション無しで、セルに表示させたいと思ってます

今、教えてもらった過去ログを拝見しておりますが、
ちょっといまいち、解読に時間がかかりそう・・・です


>>CSV内のデータ
>>"111","222","333","444","555"
>>"666","7,77","888","999","10000"
>>上記のようなcsvデータがあって、
>>Splitでカンマの位置で分割して配列にしているのですが、
>
>セルに
>「"111"」と読み込みたいのでしょうか?(Wクォーテーション付き)
>「111」それともこっち?
>

>とりあえず過去ログ。
>他にもたくさんあると思いますよ。
>
>OpenTextFile
>ht tp://www.vbalab.net/vbaqa/c-board.cgi?page=&no=5244&mode=tre&id=excel&cmd=jmp
>
>input
>注)Inputで読み込むと"  ああ  " など、両端のスペースがTrimされたようになる。
>ht tp://www.vbalab.net/vbaqa/data/excel/log/tree_373.htm#1910
>コピペの方法は、、
>ht tp://www.vbalab.net/vbaqa/c-board.cgi?page=&no=2205&mode=one&id=&cmd=jmp
>
>Dao(石鹸箱の記事番号2645)
>ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=2645;id=

【67973】Re:CSVの取込について
発言  SS  - 11/1/20(木) 9:12 -

引用なし
パスワード
   ▼なな さん:

横から失礼します。
単純にやるとこんな感じでしょうか。
Sub test()
  Dim tmp As String, tmp1 As String, tmp2 As String
  Dim s As Variant
  
  tmp = ThisWorkbook.Worksheets("Sheet1").Range("A1").Value
    ' "666","7,77","888","999","10000"の設定が面倒だったので
    ' セルから読み込ませています。
    
  tmp1 = Replace(tmp, """,""", "@")
    ' 区切りのカンマを周りのWクォーテーションごと適当な文字に変換
  tmp2 = Replace(tmp1, """", "")
    ' 不要なWクォーテーションを消去
  s = Split(tmp2, "@")
    ' 区切りに設定した文字列で分割
  MsgBox s(0) & Chr(10) & s(1) & Chr(10) & s(2) & Chr(10) & _
      s(3) & Chr(10) & s(4)
    ' 分割結果を表示確認
End Sub

>▼Jaka さん:
>
>返信ありがとうございます
>
>「111」です
> Wクォーテーション無しで、セルに表示させたいと思ってます
>
>今、教えてもらった過去ログを拝見しておりますが、
>ちょっといまいち、解読に時間がかかりそう・・・です
>

【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

【67975】Re:CSVの取込について
発言  kanabun  - 11/1/20(木) 10:50 -

引用なし
パスワード
   ▼なな さん:
こんにちは〜

>CSV内のデータ
>"111","222","333","444","555"
>"666","7,77","888","999","10000"
>上記のようなcsvデータがあって、
>Splitでカンマの位置で分割して配列にしているのですが、

こんな方法はどうでしょう?
一行データの【"】を区切り記号としてSplitして、
ひとつ置きに配列に格納しています。


>"666","7,77","888","999","10000"
これをダブルクォートで Splitすると、

(0) (1) (2)  (3)  (4) (5) (6) (7) (8) (9)  (10)
""  666 ,  7,77  ,  888  ,  999 ,  10000  ""  

となるので、(1),(3),(5),(7),(9) 番目のデータを配列に入れる
という塩梅です(^^

Sub Try1()
 Dim myCSV As String
 Dim Fso As FileSystemObject
 Dim ss As String
 Dim data, v
 
  myCSV = "D:\(Data)\CSVs\カンマ入ダブルクォート.csv"
  Set Fso = New FileSystemObject
  With Fso.OpenTextFile(myCSV)
    ss = .ReadAll
    .Close
  End With
  data = Split(ss, vbCrLf)
  
 Const WQuote = """"
 Dim i As Long, j As Long, k As Long, n As Long
 n = UBound(data) - 1
 ReDim myData(1 To n, 1 To 5)
  For i = 1 To n
    v = Split(data(i), WQuote)
    k = 0
    For j = 1 To UBound(v) Step 2
      k = k + 1
      myData(i, k) = v(j)
    Next
  Next
  ActiveSheet.Range("A2").Resize(n, 5).Value = myData
End Sub

【67976】Re:CSVの取込について
回答  Hirofumi  - 11/1/20(木) 11:28 -

引用なし
パスワード
   こんなのでは?

Option Explicit

Public Sub DataRead()

  Dim i As Long
  Dim vntFileName As Variant
  Dim lngRow As Long
  Dim strPath As String
  Dim rngResult As Range
  Dim strProm As String

  '指定形式のファイル名を取得
  strPath = ThisWorkbook.Path
  If Not GetReadFile(vntFileName, strPath) Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If

  '◆出力先頭セル位置を設定(基準セル位置)
  Set rngResult = ActiveSheet.Cells(1, "A")
  
  '画面更新を停止
  Application.ScreenUpdating = False
  
  'データの読み込み
  CSVRead vntFileName, rngResult, lngRow

  strProm = "処理が完了しました"

Wayout:

  Set rngResult = Nothing

  '画面更新を再開
  Application.ScreenUpdating = True

  MsgBox strProm, vbInformation

End Sub

Private Sub CSVRead(ByVal strFileName As String, _
          ByRef rngWrite As Range, _
          Optional ByRef lngRow As Long = 1, _
          Optional strDelim As String = ",")

  Dim i As Long
  Dim dfn As Integer
  Dim vntField As Variant
  Dim strBuff As String
  Dim blnMulti As Boolean
  Dim strRec As String
  
  'ファイルをOpen
  dfn = FreeFile
  Open strFileName For Input As dfn

  Do Until EOF(dfn)
    '1行読み込み
    Line Input #dfn, strBuff
    '論理レコードに物理レコードを追加
    strRec = strRec & strBuff
    '論理レコードをフィールドに分割
    vntField = SplitCsv(strRec, strDelim, , , blnMulti)
    'フィールド内で改行が有る場合
    If Not blnMulti Then
      With rngWrite.Offset(lngRow)
        '出力範囲を文字列に設定
'        .Offset(, 1).Resize(, 2).NumberFormat = "@"
        'データを出力
        .Resize(, UBound(vntField) + 1).Value = vntField
      End With
      '出力行をインクリメント
      lngRow = lngRow + 1
      strRec = ""
    Else
      'セル内改行として残す場合
      strRec = strRec & vbLf
    End If
  Loop

  Close #dfn

End Sub

Private Function SplitCsv(ByVal strLine As String, _
            Optional strDelimiter As String = ",", _
            Optional strQuote As String = """", _
            Optional strRet As String = vbCrLf, _
            Optional blnMulti As Boolean) As Variant

  Dim i As Long
  Dim lngDPos As Long
  Dim vntData() As Variant
  Dim lngStart As Long
  Dim vntField As Variant
  Dim lngLength As Long

  i = 0
  lngStart = 1
  lngLength = Len(strLine)
  blnMulti = False
  Do
    ReDim Preserve vntData(i)
    If Mid$(strLine, lngStart, 1) <> strQuote Then
      lngDPos = InStr(lngStart, strLine, _
            strDelimiter, vbBinaryCompare)
      If lngDPos > 0 Then
        vntField = Mid$(strLine, lngStart, _
                  lngDPos - lngStart)
        If lngDPos = lngLength Then
          ReDim Preserve vntData(i + 1)
        End If
        lngStart = lngDPos + 1
      Else
        vntField = Mid$(strLine, lngStart)
        lngStart = lngLength + 1
      End If
    Else
      lngStart = lngStart + 1
      Do
        lngDPos = InStr(lngStart, strLine, _
                strQuote, vbBinaryCompare)
        If lngDPos > 0 Then
          vntField = vntField & Mid$(strLine, _
                lngStart, lngDPos - lngStart)
          lngStart = lngDPos + 1
          Select Case Mid$(strLine, lngStart, 1)
            Case ""
              Exit Do
            Case strDelimiter
              lngStart = lngStart + 1
              Exit Do
            Case strQuote
              lngStart = lngStart + 1
              vntField = vntField & strQuote
          End Select
        Else
          blnMulti = True
          vntField = Mid$(strLine, lngStart)
          lngStart = lngLength + 1
          Exit Do
        End If
      Loop
    End If
    vntData(i) = vntField
    vntField = Empty
    i = i + 1
  Loop Until lngLength < lngStart

  SplitCsv = vntData()

End Function

Private Function GetReadFile(vntFileNames As Variant, _
            Optional strFilePath As String, _
            Optional blnMultiSel As Boolean _
                    = False) As Boolean

  Dim strFilter As String
  
  'フィルタ文字列を作成
  strFilter = "CSV File (*.csv),*.csv," _
        & "Text File (*.txt),*.txt," _
        & "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
        & "全て (*.*),*.*"
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  'もし、ディフォルトのファイル名が有る場合
  If vntFileNames <> "" Then
    SendKeys vntFileNames & "{TAB}", False
  End If
  '「ファイルを開く」ダイアログを表示
  vntFileNames _
      = Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【67982】Re:CSVの取込について
お礼  なな  - 11/1/21(金) 9:46 -

引用なし
パスワード
   ▼SS さん:

ありがとうございます

私にも理解ができるプログラムで、
アドバイスどおりに試してみましたら、うまくいきました

助かりました

本当にありがとうございました

【67983】Re:CSVの取込について
お礼  なな  - 11/1/21(金) 9:51 -

引用なし
パスワード
   ▼Yuki さん:

アドバイスありがとうございます
Yukiさんの教えてもらったコードを記述して、流れをつかみながら、
試してみました。

うまくいきましたが、
まだまだ未熟なもので、解読までには至っていません

もう少し勉強してみます

ありがとうございました

【67984】Re:CSVの取込について
お礼  なな  - 11/1/21(金) 10:18 -

引用なし
パスワード
   ▼kanabun さん:
>▼なな さん:

アドバイスありがとうございます

下記のように
一つ置きに配列に格納することは思いもつきませんでした
なるほど!と感動しました

試してみましたら、うまくいきました

いろいろなやり方があるんですね

ありがとうございました

>こんな方法はどうでしょう?
>一行データの【"】を区切り記号としてSplitして、
>ひとつ置きに配列に格納しています。
>

【67985】Re:CSVの取込について
お礼  なな  - 11/1/21(金) 10:22 -

引用なし
パスワード
   ▼Hirofumi さん:

アドバイスありがとうございます

今、まだHirofumiさんのコードを解読中です
私にはまだまだ高度すぎて、
理解するのにもう少し時間がかかりそうです

でも、いろいろな方法があることを知り、またまた勉強になりました

解読にむけてがんばってみます

ありがとうございました

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