Excel VBA質問箱 IV

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

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


12905 / 13644 ツリー ←次へ | 前へ→

【8040】EXCEL97でテキストファイルをインポート時にメモリ不足 maeda 03/9/27(土) 14:41 質問
【8041】Re:EXCEL97でテキストファイルをインポート... Hirofumi 03/9/27(土) 16:55 発言
【8048】Re:EXCEL97でテキストファイルをインポート... Hirofumi 03/9/27(土) 22:21 回答
【8050】Re:EXCEL97でテキストファイルをインポート... maeda 03/9/28(日) 12:55 質問
【8052】Re:EXCEL97でテキストファイルをインポート... Hirofumi 03/9/28(日) 15:01 回答
【8054】Re:EXCEL97でテキストファイルをインポート... Hirofumi 03/9/28(日) 17:51 発言
【8055】Re:EXCEL97でテキストファイルをインポート... maeda 03/9/28(日) 21:13 お礼

【8040】EXCEL97でテキストファイルをインポート時...
質問  maeda  - 03/9/27(土) 14:41 -

引用なし
パスワード
   みなさま、こんにちは

EXCEL97でテキスト(拡張子.txtのCSVファイル)ファイルをインポートする
マクロを自動生成したのですが、「メモリが不足しています。」というエラーが
出力されて困っております。
テキストファイルの各列に「G/標準」「文字列」「日付」などの形式を設定して
インポートするのですが、まず、マクロを自動記録しながら手動で
テキストファイルウィザードを使って取り込みました。手動で行う分には全く
問題無くEXCELに取り込むことができます。
しかし、そこで自動生成されたマクロ(下)を実行してみると
「メモリが不足しています。」というエラーが出力され正常に動作してくれません。

  Workbooks.OpenText FileName:= _
    "C:\work\CSVFILE.txt", StartRow:=1, _
     DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
     ConsecutiveDelimiter:=False, Tab:=False, _
     Semicolon:=False, Comma:=True, _
     Space:=False, Other:=False, _
     FieldInfo:=Array(Array(1, 1), _
Array(2, 1),Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1),Array(9, 2), _
Array(10, 2), Array(11, 1), Array(12, 1), ..<省略>.. _
Array(96, 1), Array(97, 1), Array(98, 1), Array(99, 1), _
Array(100, 2), Array(101, 2), Array(102, 2), Array(103, 2), _
Array(104, 2), Array(105, 1))

列が105列あるのですが、「メモリが不足しています。」が出力されるとカーソルが
Array59の位置にフォーカスされるので1文で文字数が多すぎるのかとも思います。
しかし、この文を分割したり短くしたりする方法もわかりません。
どなたか「メモリが不足しています。」というエラーを回避しながら105列あるテキスト
ファイルを取り込む方法をお教えいただけないでしょうか?
ちなみにEXCEL2000だと問題無く処理が完了します。
よろしくお願いいたします。

maeda

【8041】Re:EXCEL97でテキストファイルをインポー...
発言  Hirofumi E-MAIL  - 03/9/27(土) 16:55 -

引用なし
パスワード
   ハッキリし無い話しで申し訳有りませんが
確か前に、Arrayで渡す事が出来る配列のインデックスに上限が有り、
其れが、60ぐらいだった様な事が話題に成っていたと思います
此れがExcel2000で改善されているのかも知れません

Excel97のHelpによると
「列の指定は、どのような順番で行ってもかまいません。
指定されなかった列は、標準形式だと解釈されます。」
と有りますので
 FieldInfo:=Array(
の中で、1を指定している所を減らして59以内する事を考えたら如何ですか?

尚、他のサイトで同じ質問をされているようですね、
ここではうるさく無いのですが、向こうではマルチポストと言って禁止されています
謝って、どちらかの質問を解決済みにした方が善いと思いますが?

【8048】Re:EXCEL97でテキストファイルをインポー...
回答  Hirofumi E-MAIL  - 03/9/27(土) 22:21 -

引用なし
パスワード
   >ハッキリし無い話しで申し訳有りませんが
>確か前に、Arrayで渡す事が出来る配列のインデックスに上限が有り、
>其れが、60ぐらいだった様な事が話題に成っていたと思います
>此れがExcel2000で改善されているのかも知れません

テストして見た所、私の勘違いだった様で、Array関数その物は、
60以上でも大丈夫でした
尚、Workbooks.OpenTextの引数をArrayでした時、
「FieldInfo:=Array(」は51個までしか設定出来ませんでした
しかし、例えばArray(34, 1)の様に標準として設定している物を削除して
51個以内に収めれば実行できるみたいですね

【8050】Re:EXCEL97でテキストファイルをインポー...
質問  maeda  - 03/9/28(日) 12:55 -

引用なし
パスワード
   Hirofumiさん、ご返信ありがとうございます
デフォルトはG/標準になることからデフォルト以外のみをArrayに
指定してみたのですが、列の位置が50以上の場合は形式指定が無視されてしまうようです。
「メモリが不足しています」というエラーは表示されなくなり、
処理自体も実行され正常に動いているように見えるのですが、
列の形式は50番以下までしか設定されず、それ以上大きい番号の列は全てG/標準
になってしまうようです。
極端な話下のような指定でもArray100は「文字列」ではなく、
「G/標準」になってしまうようです。

FieldInfo:=Array(Array(1, 2), Array(100, 2)

これを回避する方法はあるのでしょうか...
ご教授いただければ幸いです。

【8052】Re:EXCEL97でテキストファイルをインポー...
回答  Hirofumi E-MAIL  - 03/9/28(日) 15:01 -

引用なし
パスワード
   >これを回避する方法はあるのでしょうか...
>ご教授いただければ幸いです。

お役に立てなくて申し訳有りませんが、
私はBookとしてファイルを開く事を余りしないので、
直接、この件の解決策を提示できません

しかし、Bookとしてファイルを開くではなく、シートに直接読み込むなら以下の様な
コードで読めると思います

尚、このコードで読み込む場合、処理速度は期待しないで下さい
かなり遅いと思います
また、提示のコードは、アクティブシートのA列1行から書き込みます
書き込むシートを指定したい場合は、「書き込むシートの参照を設定」のActiveSheet
と成っている所を変更して下さい
また、「書き込む先頭行の初期値」と「書き込む先頭列の初期値」を変更すれば、
書き込む行列が変更できます
また、「vntFieldInfo = Array(」の所はOpenTextのFieldInfoと同じ設定方式にした積もりです

以下を同一の標準モジュールに記述して下さい

Option Explicit

Public Sub ReadCsv()

  Dim i As Long
  Dim vntFileName As Variant
  Dim vntFieldInfo As Variant
  Dim lngWriteRow As Long
  Dim lngWriteCol As Long
  Dim wksWrite As Worksheet
  Dim strPath As String
  
  '読み込むファイル名を取得
'  vntFileName = "CSVFILE"
'  strPath = "C:\work"
  vntFileName = "CSVTest1"
  strPath = ThisWorkbook.Path
  If Not GetReadFile(vntFileName, strPath) Then
    Exit Sub
  End If
  
'  Application.ScreenUpdating = False
  
  '書き込む先頭行の初期値
  lngWriteRow = 1
  '書き込む先頭列の初期値
  lngWriteCol = 1
  '書き込むシートの参照を設定
  Set wksWrite = ActiveSheet
  'FieldInfoを設定(OpenTextのFieldInfoと同じ?)
  vntFieldInfo = Array(Array(1, 2), Array(2, 2), Array(3, 2), _
            Array(16, 2), Array(17, 2), Array(18, 2), _
            Array(31, 2), Array(32, 2), Array(33, 2), _
            Array(46, 2), Array(47, 2), Array(48, 2), _
            Array(61, 2), Array(62, 2), Array(63, 2), _
            Array(76, 2), Array(77, 2), Array(78, 2), _
            Array(91, 2), Array(92, 2), Array(93, 2))
  'セルの書式を設定
  CellsFormat vntFileName, wksWrite, vntFieldInfo, _
                  lngWriteRow, lngWriteCol
  'シートに読み込み
  CSVReadSeq vntFileName, wksWrite, _
              lngWriteRow, lngWriteCol, True, ","
  
  Set wksWrite = Nothing
  
'  Application.ScreenUpdating = True
  
End Sub

Private Sub CSVReadSeq(ByVal strFileName As String, _
              ByVal wksWrite As Worksheet, _
              Optional ByRef lngRow As Long = 1, _
              Optional ByRef lngCol As Long = 1, _
              Optional ByRef blnHeader As Boolean = True, _
              Optional strDelim As String = ",")
  
  Dim dfn As Integer
  Dim vntField As Variant
  Dim strLine As String
  Dim blnMulti As Boolean
  Dim strRec As String
  
  '空きファイル番号を取得
  dfn = FreeFile
  'ファイルをInputモードでOpen
  Open strFileName For Input As dfn
  
  'ファイルEndまで繰り返し
  Do Until EOF(dfn)
    '1レコード読み込む
    Line Input #dfn, strLine
    '論理レコードに物理レコードを加算
    strRec = strRec & strLine
    'レコードをフィールドに分割
    vntField = SplitLine(strRec, strDelim, , , blnMulti)
    'もし、1論理レコードが複数行に渡るなら
    If blnMulti Then
      '論理レコードにLfを付加
      strRec = strRec & vbLf
    Else
      If blnHeader Then
        '書き込みシートの指定行列を先頭として
        With wksWrite.Cells(lngRow, lngCol)
          '1レコード文のフィールを書き込み
          .Offset.Resize(, UBound(vntField) + 1) = vntField
        End With
        '書き込み行を更新
        lngRow = lngRow + 1
      End If
      strRec = ""
      blnHeader = True
    End If
  Loop
  
  Close #dfn
  
End Sub

Private Sub CellsFormat(ByVal strFileName As String, _
            ByVal wksWrite As Worksheet, _
            vntFieldAtt As Variant, _
            Optional ByVal lngRow As Long = 1, _
            Optional ByVal lngCol As Long = 1)

'  セルの書式設定
  
  Dim i As Long
  Dim dfn As Integer
  Dim lngRowCount As Long
  Dim strBuff As String
  Dim lngFormatCol As Long
  
  '空きファイル番号を取得
  dfn = FreeFile
  'ファイルをOpen
  Open strFileName For Input As dfn
  lngRowCount = 0
  Do Until EOF(dfn)
    Line Input #dfn, strBuff
    '行数を取得
    lngRowCount = lngRowCount + 1
  Loop
  'ファイルをClose
  Close #dfn
  
  '指定シートに就いて
  With wksWrite
    'FieldInfo全てに就いて繰り返し
    For i = 0 To UBound(vntFieldAtt, 1)
      '設定列を設定
      lngFormatCol = vntFieldAtt(i)(0) - 1
      '設定列の列の範囲を設定
      With .Cells(lngRow, lngCol + lngFormatCol)
        With Range(.Offset(), _
            .Offset(lngRow + lngRowCount - 2))
          'FieldInfoに従い書式を設定
          Select Case vntFieldAtt(i)(1)
            Case 1
              .NumberFormatLocal = "G/標準"
            Case 2
              .NumberFormatLocal = "@"
            Case 5
              .NumberFormatLocal = "yyyy/mm/dd"
          End Select
        End With
      End With
    Next i
  End With
  
End Sub

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

'      strLine     :分割元と成る文字列
'      strDelimiter  :区切り文字
'      SplitLine    :戻り値、切り出された文字配列

  Dim lngDPos As Long
  Dim vntData() As Variant
  Dim lngStart As Long
  Dim i As Long
  Dim vntField As String
  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)
        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) & strRet
          lngStart = lngLength + 1
          Exit Do
        End If
      Loop
    End If
    vntData(i) = vntField
    vntField = ""
    i = i + 1
  Loop Until lngLength <= lngStart
  
  SplitLine = vntData()
  
End Function

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

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

【8054】Re:EXCEL97でテキストファイルをインポー...
発言  Hirofumi E-MAIL  - 03/9/28(日) 17:51 -

引用なし
パスワード
   書き忘れた事と、テストして気が就いた事が有るのでUpして置きます
私の環境はWin98無印、Excel97です

1、vntFieldInfoのArrayで設定できるフィールドの数
 私の環境では、53個までしか設定出来ませんでした
 しかし、OpenTextの時と違って50以上の位置でも設定は出来ると思います
 と言うより、私の環境では出来ました

2、「セルの書式設定」のプロシージャ「Sub CellsFormat」において
 書式は都合の言い様に修正して下さい
 現状では、1がG/標準、2が文字列、5が"yyyy/mm/dd"形式の日付、其れ以外は設定されません
 もし、"yyyy/m/d"形式にしたければ、5の"yyyy/mm/dd"を変更するか、違う番号に登録して下さい
 また、私の環境では、CSVファイルの日付フィールドがyyyy/mm/dd形式で記録されていれば、
 セルの設定をしていなくても、yyyy/m/d形式で読み込まれています
 したがって、"064"の様な物を、"64"に成らない様に文字列に設定するぐらいだと思います

3、「Sub ReadCsv()」で、

  Set wksWrite = Nothing

 の前に

  wksWrite.Cells.EntireColumn.AutoFit
 
 を入れて置けば、読み込み後、自動的にセル幅が内容に合わされます

4、「Sub ReadCsv()」で、

  '読み込むファイル名を取得
'  vntFileName = "CSVFILE"
'  strPath = "C:\work"
  vntFileName = "CSVTest1"
  strPath = ThisWorkbook.Path

 と有りますが、下の2行は私のテスト用で、
 削除して、上の2行のコメントアウトを外して下さい
 又、直接、ファイル名を指定するなら、

  If Not GetReadFile(vntFileName, strPath) Then
    Exit Sub
  End If

 を削除して、

  vntFileName = "C:\work\CSVFILE.txt"

 として下さい

5、アクティブシートに読み込まれるので、もし、OpenTextの様に新規のBookとして
 読み込む様にしたければ

'  Application.ScreenUpdating = False
 の後に

  Workbooks.Add

 とすれば新規Bookが作成され其処に読み込まれます

【8055】Re:EXCEL97でテキストファイルをインポー...
お礼  maeda  - 03/9/28(日) 21:13 -

引用なし
パスワード
   Hirofumiさん
親切なご対応と具体的な代替案のご提示本当にありがとうございます。
EXCEL97では仕様上の問題で、マクロでは約50列以上あるテキストファイルは
正常に取り込めないこと、どうしてもEXCEL97で取り込めるようにしたい場合は
代替案で処理が遅くなる旨お客に理解していただくよう話してみることにしました。
また何かありましたらその時はよろしくお願いいたします。
ありがとうございました。

※ 別サイトの質問の件は解決済みとさせていただきました。

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