Excel VBA質問箱 IV

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

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


76640 / 76738 ←次へ | 前へ→

【4516】Re:ファイルを複数選択して開く時の対処
回答  Jaka  - 03/3/25(火) 15:20 -

引用なし
パスワード
   こんにちは。

>Workbooks.Open FileName:=vFileName(i) '←ここで処理が完了しているようです。
と言うよりWorkbooks.Openで、CSVファイルを開いた時のめちゃくちゃ遅い処理の性じゃないかと...。
2000だったらクエリで開いちゃう方法もありますが、CSVをTxtにかえて読み込む方法を...。
因に、OpenTextですべて文字列として読み込む方法の方が速くて良いんですが、それじゃ嫌だという人もいて...。

最後に、CSVファイルの1行目を読み込んで、この列は文字列、この列は標準と言った判断をして開いているんですが、この辺りの判断が人によってまちまちな読み込み方をするので、私の好き勝手な方法で判断しています。
尚、こう言うところは文字列で、こう言うところは標準で読み込みたいです。と言われてもどうやって作ったんだか覚えていないので、直すのにメチャクチャ時間が掛かると思う。
確か、ロジックを考えるのが嫌でステップ実行して、つど付け足したり修正していったんだと思う。

違ってたらごめんなさい。


Sub test()
  Dim vFileName As Variant
  Dim sDefaultPath As String, iFileName As String
  'デフォルトパスの設定(必要に応じて)
  sDefaultPath = "C:\"
  ChDrive sDefaultPath
  ChDir sDefaultPath
  'Excelファイル名の入力(複数選択)
  vFileName = Application.GetOpenFilename( _
  fileFilter:=StrConv("CSV ファイル (*.CSV),*.x*," & _
  "すべてのファイル (*.*),*.*", vbNarrow), filterIndex:=1, _
    MultiSelect:=True)
  'キャンセルされたかチェック(キャンセル時MSG出力)
  If VarType(vFileName) = 11 Then
    MsgBox "キャンセルされました。"
    Exit Sub
  End If
'複数ファイル選択
  Dim I As Integer
  Dim MSG As String
  tti = LBound(vFileName)
  For I = 1 To UBound(vFileName)
    
    'Workbooks.Open FileName:=vFileName(I) '←ここで処理が完了しているよう
                          'です。
    
    iFileName = Left(Dir(vFileName(I)), Len(Dir(vFileName(I))) - 4)
    TxtN = Left(vFileName(I), Len(vFileName(I)) - 3) & "txt"
    Name vFileName(I) As TxtN
    CSVOpen (TxtN)

'データ処理
    G = G + 1
    Workbooks("test.xls").Sheets("ワーク").Range("A" & G).FormulaR1C1 = iFileName 'ファイル名をA列に記述

'(データ量が多すぎ、'データ処理以前で処理が中止されるので以後の処理を割愛)
    Workbooks(Dir(TxtN)).Close
    Name TxtN As Left(TxtN, Len(TxtN) - 3) & "csv"
    
  Next I
  MsgBox "ファイル数:" & UBound(vFileName) & "個 が選択されました。"
End Sub

Sub CSVOpen(VFN)
  Dim ReadData As String, myFieldInfo(), I As Long, CNT As Integer
  Dim CommaCnt As Integer, WQoFlg As Integer
  Dim FTypTB() As Integer, CSVFlg As Boolean, MojFlg As Integer
  Dim StMsg As String, FieldData As String
  
  Open VFN For Input As #1
  Line Input #1, ReadData
  Close #1
  CNT = 0: WQoFlg = 0: MojFlg = 0: FieldData = Empty
  For I = 1 To Len(ReadData)
    If I = 518 Then
      hy = 0
    End If
    If Mid(ReadData, I, 1) = "," And (WQoFlg = 0 Or WQoFlg = 2) Then
      CNT = CNT + 1
      CommaCnt = CommaCnt + 1
      ReDim Preserve FTypTB(1 To CNT)
      If MojFlg = 0 And WQoFlg = 0 Or (IsNumeric(fileddata) = True And _
       (InStr(1, FieldData, "-") > 0 Or InStr(1, FieldData, ",") > 0)) Then
       FTypTB(CNT) = 1
      Else
       FTypTB(CNT) = 2
      End If
      FieldData = Empty
      MojFlg = 0
      WQoFlg = 0
    ElseIf Mid(ReadData, I, 1) = Chr(34) And WQoFlg = 0 Then
      WQoFlg = 1
    ElseIf Mid(ReadData, I, 1) = Chr(34) And WQoFlg = 1 Then
      WQoFlg = 2
      If I = Len(ReadData) Then
       CNT = CNT + 1
       ReDim Preserve FTypTB(1 To CNT)
       FTypTB(CNT) = 2
      End If
    ElseIf Mid(ReadData, I, 1) = "," And WQoFlg = 2 Then
      WQoFlg = 0
      MojFlg = 0
      CommaCnt = CommaCnt + 1
    ElseIf IsNumeric(Mid(ReadData, I, 1)) = False Then
      MojFlg = 1
      FieldData = FieldData & Mid(ReadData, I, 1)
    ElseIf I = Len(ReadData) And (MojFlg = 1 Or IsNumeric(Mid(ReadData, I, 1)) = False) Then
      CNT = CNT + 1
      ReDim Preserve FTypTB(1 To CNT)
      If IsNumeric(FieldData) = True And _
       (InStr(1, FieldData, "-") > 0 Or InStr(1, FieldData, ",") > 0) Then
       FTypTB(CNT) = 1
      Else
       FTypTB(CNT) = 2
      End If
      FieldData = Empty
      MojFlg = 0
    ElseIf I = Len(ReadData) Then
      CNT = CNT + 1
      ReDim Preserve FTypTB(1 To CNT)
      FTypTB(CNT) = 1
      MojFlg = 0
    ElseIf Mid(ReadData, I, 1) <> Chr(34) Then
      FieldData = FieldData & Mid(ReadData, I, 1)
    End If
  Next
  ReDim myFieldInfo(1 To CommaCnt + 1)
  For I = 1 To CommaCnt + 1
    If FTypTB(I) = 1 Then
      myFieldInfo(I) = Array(I, FTypTB(I))
    Else
      myFieldInfo(I) = Array(I, FTypTB(I))
    End If
  Next
  Workbooks.OpenText FileName:=VFN, _
       DataType:=xlDelimited, Comma:=True, FieldInfo:=myFieldInfo
  Erase FTypTB
  Erase myFieldInfo
End Sub

4 hits

【4512】ファイルを複数選択して開く時の対処 ntomo 03/3/25(火) 11:39 質問
【4516】Re:ファイルを複数選択して開く時の対処 Jaka 03/3/25(火) 15:20 回答
【4517】消し忘れ Jaka 03/3/25(火) 15:29 発言
【4518】Re:ファイルを複数選択して開く時の対処 ntomo 03/3/25(火) 15:48 お礼
【4520】Re:ファイルを複数選択して開く時の対処 Jaka 03/3/25(火) 16:25 回答
【4526】Re:ファイルを複数選択して開く時の対処 ntomo 03/3/25(火) 17:03 お礼
【5244】今ごろ見つかったバグ? Jaka 03/4/30(水) 13:10 発言
【5312】Re:今ごろ見つかったバグ? ntomo 03/5/6(火) 15:20 お礼

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