0

150 万行のデータを含むテキスト ファイル (.txt) があります。データ (書式なし) を Excel (2007) にインポートしたい。問題は、Excel がタブごとに 100 万行しか処理できないことです。データを行ごとにコピーするコードをセットアップしましたが、行 594,139 で停止し続けます。理由がわかりません。

次のVBAコードの作成を手伝ってください。

  • テキスト ファイルを開き、一度に 200,000 行のデータをコピーします。
  • データを Excel (書式なし) に入れます。
  • テキスト ファイル (など) から次の 200,000 行を取得し、以前のデータの下に Excel に配置します。
  • Excel が 1,000,000 行に達したら、新しいタブを設定し、引き続き Excel にデータを入力します。

上記は単純に聞こえますが、現在のマクロは完了していません。

どんな助けでも本当にありがたいです、

以下は私の元のコードです。ブロック (200,000 行) ごとにテキストをコピーしようとしましたが、行ごとに試しました。

サブラージファイルインポート()

  Dim ResultStr As String
  Dim FileName As String
  Dim FileNum As Integer
  Dim Counter As Double
  FileName = ThisWorkbook.Path & "\" & InputBox("Please enter the Text File's name, e.g. ifs_ytd_fut") & ".txt"
  If FileName = "" Then End
  FileNum = FreeFile()
  Open FileName For Input As #FileNum
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Dim mypath As String
  mypath = ThisWorkbook.Path
 Workbooks.Add template:=xlWorksheet
 ActiveWorkbook.SaveAs (mypath & "/Extract.xls")
 Application.DisplayAlerts = True
 Application.ScreenUpdating = False
 Counter = 1
  Range("A1").Select
 Do While Seek(FileNum) <= LOF(FileNum)
  Application.StatusBar = "Importing Row " & _
         Counter & " of text file " & FileName
  Line Input #FileNum, ResultStr
  If Left(ResultStr, 1) = "=" Then
         ActiveCell.Value = "'" & ResultStr
  Else
         ActiveCell.Value = ResultStr
  End If
  If ActiveCell.Row = 1000000 Then
       ActiveWorkbook.Sheets.Add After:=ActiveSheet
      Else
  ActiveCell.Offset(1, 0).Select
      End If
  Counter = Counter + 1
  Loop
  Close
  Application.StatusBar = False
  Application.ScreenUpdating = True
  End Sub

CK。

4

1 に答える 1

1

このようなものはあなたのために働くはずです

Sub Tester()

Const LINES_PER_SHEET As Long = 500000
Dim ResultStr As String
Dim FileName As String
Dim FileNum
Dim Counter As Long, r As Long
Dim wbNew As Excel.Workbook
Dim arr()
Dim mypath As String

    mypath = ThisWorkbook.Path

    FileName = ThisWorkbook.Path & "\" & _
               InputBox("Please enter the Text File's name, e.g. ifs_ytd_fut") & ".txt"
    If FileName = "" Then Exit Sub

    FileNum = FreeFile()
    Open FileName For Input As #FileNum

    Set wbNew = Workbooks.Add(template:=xlWorksheet)
    wbNew.SaveAs (mypath & "/Extract.xls")

    Counter = 0
    r = 0

    ReDim arr(1 To LINES_PER_SHEET, 1 To 1)

    Do While Not EOF(FileNum)

        If Counter Mod 1000 = 0 Then
            Application.StatusBar = "Importing Row " & _
             Counter & " of text file " & FileName
        End If

        Counter = Counter + 1
        r = r + 1
        Line Input #FileNum, ResultStr
        If Left(ResultStr, 1) = "=" Then ResultStr = "'" & ResultStr

        arr(r, 1) = ResultStr
        If r = LINES_PER_SHEET Then
            ArrayToSheet wbNew, arr
            r = 0
        End If
    Loop

    If Counter Mod LINES_PER_SHEET > 0 Then ArrayToSheet wbNew, arr

    Close #FileNum
    Application.StatusBar = False


End Sub

Sub ArrayToSheet(wb As Workbook, ByRef arr)
    Dim r As Long
    r = UBound(arr, 1)
    With wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        .Range("A1").Resize(r, 1).Value = arr
    End With
    ReDim arr(1 To r, 1 To 1)
End Sub
于 2012-08-26T19:27:56.820 に答える