Excel VBA質問箱 IV

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

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


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

【10048】テキストファイルの読み込み yukko 04/1/5(月) 12:40 質問
【10050】Re:テキストファイルの読み込み Jaka 04/1/5(月) 13:49 発言
【10053】Re:テキストファイルの読み込み yukko 04/1/5(月) 15:37 お礼
【10054】Re:テキストファイルの読み込み Jaka 04/1/5(月) 16:14 回答
【10055】Re:テキストファイルの読み込み yukko 04/1/5(月) 16:17 回答
【10057】Re:テキストファイルの読み込み Jaka 04/1/5(月) 16:48 質問
【10058】Re:テキストファイルの読み込み yukko 04/1/5(月) 17:08 回答
【10060】Re:テキストファイルの読み込み(追加説明) yukko 04/1/5(月) 18:11 回答
【10067】Re:テキストファイルの読み込み(追加説明) Kein 04/1/5(月) 22:37 回答
【10068】Re:テキストファイルの読み込み(追加説明) yukko 04/1/5(月) 23:02 お礼
【10069】Re:テキストファイルの読み込み(追加説明) yukko 04/1/5(月) 23:07 お礼
【10070】Re:テキストファイルの読み込み yukko 04/1/5(月) 23:12 お礼
【10072】書いてきちゃったんで一応載っけときます。 Jaka 04/1/6(火) 9:08 回答
【10074】Re:書いてきちゃったんで一応載っけときま... yukko 04/1/6(火) 10:27 お礼

【10048】テキストファイルの読み込み
質問  yukko  - 04/1/5(月) 12:40 -

引用なし
パスワード
    みなさん、明けましておめでとうございます。
下記のプログラムは「りんさん」が過去に作成された
プログラムですが、これを利用したいのです・・・・すいません
 テキストファイルをSheet1に5デ−タ目から3000個
その後3000個づつB列からC列へと読み込みたいのですが
どうすれば良いでしょうか?(だいたい150列位のなると思いますが)
但し2行目から3002行目の間に読み込みたいのです
 1行目と3003行目からは関数がありますから
 テキストファイルの1デ−タ〜5デ−タ目は不要な
デ−タです。
 
Sub test()
  Application.ScreenUpdating = False
  Dim tf As Boolean
  Ifile = Application.GetOpenFilename("csv ファイル (*.csv), *.csv")
  If Ifile <> False Then
   '3000Rec毎に分割する
   Rmax& = 3000
   '開始
   tf = False: II& = 0: Nmax% = 0
   Open Ifile For Input As #1
     Do Until EOF(1)
      II& = II& + 1: Line Input #1, A$
      If II& Mod Rmax& = 1 Then
        Nmax% = Nmax% + 1
        cfile$ = "Page_" + Format(Nmax%, "000") + ".csv"
        Open cfile$ For Output As #2
        Application.StatusBar = "分割中! " + cfile$
        tf = True
      End If
      '
      Print #2, A$
      '
      If II& Mod Rmax& = 0 Then
        Close #2: tf = False
      End If
     Loop
   Close #1
   If tf = True Then Close #2: tf = False
   '
   'ブックに読み込む
   Dim wb1 As Workbook, wb2 As Workbook
   For NN% = 1 To Nmax%
     cfile$ = "Page_" + Format(NN%, "000") + ".csv"
     Application.StatusBar = "読み込み " + cfile$
     Set wb2 = Workbooks.Open(cfile$, Format:=2)
     If NN% = 1 Then
      wb2.Worksheets(1).Copy
      Set wb1 = ActiveWorkbook
     Else
      With wb2
        .Worksheets(1).Copy after:=wb1.Worksheets(NN% - 1)
      End With
     End If
     wb2.Saved = True
     wb2.Close
     Kill cfile$
   Next
   wb1.Saved = True
   Set wb1 = Nothing: Set wb2 = Nothing
  Else
   MsgBox "キャンセル", vbCritical
  End If
  Application.ScreenUpdating = True
  Application.StatusBar = False
End Sub

【10050】Re:テキストファイルの読み込み
発言  Jaka  - 04/1/5(月) 13:49 -

引用なし
パスワード
   ここも見て見てねね!
[#1910]
[#1911]

>5デ−タ目から
データ行数もカウントしているので、修正しやすいと思います??

【10053】Re:テキストファイルの読み込み
お礼  yukko  - 04/1/5(月) 15:37 -

引用なし
パスワード
    Jakaさん
早々のメ−ルありがとうございます。
 デ−タを読み込んでいるのですが
sheetが増加されるばかりでsheetにデ−タが読み込まれないのですが
何故でしょうか?
 ちなみにデ−タ数は440000デ−タ位です。
1つのsheetに3000デ−タづつを並べたいのですが。
 忙しいとは思いますが、宜しくお願いします。

【10054】Re:テキストファイルの読み込み
回答  Jaka  - 04/1/5(月) 16:14 -

引用なし
パスワード
   あの、どこか修正しましたか?
そのままコピペして試して見たんですよね?
エラーになっているわけではないですよね?

何か途中で注意メッセージみたいな者は出ませんでしたか?
440000ってデータ行数の事でしょうか?
全データ行数は、いくつってでました。

440000行も有るならシート枚数が全部で146枚になっちゃうので、改良が必要です。
確か50枚までしか対応させていません。

440000行も有るデータ持っていません。
今の私のPCは6、7年ぐらい前のものなんで10000でも1分30秒〜2分ぐらい掛かってしまうのでそんなに有ると....。
フリーズしているとかそんなことはなかったですか?

因みに
基本TBL行数 = 1000 を
基本TBL行数 = 500 にした方が良いと思います。
列数が多いなら100した方が安全かも....。

【10055】Re:テキストファイルの読み込み
回答  yukko  - 04/1/5(月) 16:17 -

引用なし
パスワード
   Jakaさん
ありがとうございます。
 私の説明不足の様でしたご免なさい・・・・・・
まずデ−タの種類ですが数字ばかりで70.1とか
1つのSheetにA列に3000個、B列に3000個
と1つのSheet(144列)で納めたいのですがいかがでしょうか?

【10057】Re:テキストファイルの読み込み
質問  Jaka  - 04/1/5(月) 16:48 -

引用なし
パスワード
   例えばCSVファイルがこんな感じで、書き始めのセルをA5とすると

0.01,0.1,1,10,100
0.02,0.2,2,20,200
0.03,0.3,3,30,300
0.04,0.4,4,40,400
0.05,0.5,5,50,500

こんな感じに書き出されるはずですけど..?

   A   B   C   D   E
5 0.01  0.1   1   10  100
6 0.02  0.2   2   20  200
7 0.03  0.3   3   30  300
8 0.04  0.4   4   40  400
9 0.05  0.5   5   50  500

こう言うレイアウトでは無いのですか?

数字として扱うなら
Dim 基本TBL行数 As String をVariantとかDoubleとか適切な物に変えておいてくださいね。

さしさわり無ければ、CSVのデータを10行ほどお願いします。

【10058】Re:テキストファイルの読み込み
回答  yukko  - 04/1/5(月) 17:08 -

引用なし
パスワード
   Jakaさん
ありがとうございます。
数値の内容ですがEXCELで読み込むと

10.5
12.5
8.5
20.5
 とこんな感じでデ−タを読み込むのですが
EXCELでは40万行も読み込めないので3000デ−タづつ
をA列から140数列(各列3000行)に読み込ませたいのですが?
 すいませんお願いします。

【10060】Re:テキストファイルの読み込み(追加説...
回答  yukko  - 04/1/5(月) 18:11 -

引用なし
パスワード
   Jakaさん
ありがとうございます。
*箇所が追加説明の補足ですスイマセンです
数値の内容ですがEXCELで読み込むと

10.5
12.5
8.5
20.5
 とこんな感じでデ−タ(*1つの列に40万行*)を読み込むのですが
EXCELでは40万行も読み込めないので3000デ−タづつ
をA列から140数列(各列3000行)に読み込ませたいのですが?
 すいませんお願いします。

【10067】Re:テキストファイルの読み込み(追加説...
回答  Kein  - 04/1/5(月) 22:37 -

引用なし
パスワード
   そのファイルは、一行で一つのデータしかないわけですね ?
そうすると例えば・・

Sub Test_MyTextOP()
  Dim MyF As String
  Dim FSO As Object, MyTxt As Object
  Dim i As Integer, y As Integer, x As Long
   
  ChDir "C:\Temp" '←テキストを保存しているフォルダーのパスに変更
  With Application
   MyF = .GetOpenFilename("テキストファイル (*.csv; *.txt), *.csv; *.txt")
   If MyF = "False" Then Exit Sub
   .ScreenUpdating = False
  End With
  Set FSO = CreateObject("Scripting.FileSystemObject")
  x = 2: y = 1
  Set MyTxt = FSO.OpenTextFile(MyF, 1)
  For i = 1 To 5
   MyTxt.SkipLine
  Next i
  Do Until MyTxt.AtEndOfStream
   Cells(x, y).Value = MyTxt.ReadLine
   x = x + 1
   If x = 3003 Then
     x = 2: y = y + 1
   End If
  Loop
  MyTxt.Close
  Set MyTxt = Nothing: Set FSO = Nothing
  With Application
   ChDir .DefaultFilePath
   .ScreenUpdating = True
  End With
End Sub

【10068】Re:テキストファイルの読み込み(追加説...
お礼  yukko  - 04/1/5(月) 23:02 -

引用なし
パスワード
    Keinさん
ありがとうございます
うまく稼働しました。 
 質問があるのですが、テキストファイルの
読み込み開始行を5行目から4行目に
変更するにわマクロの何処を変更すれば良いのでしょうか??
 
 

【10069】Re:テキストファイルの読み込み(追加説...
お礼  yukko  - 04/1/5(月) 23:07 -

引用なし
パスワード
    Keinさん
ごめんなさい、勘違いしてました。
 先ほどの件は解決しました、ありがとうございました。

【10070】Re:テキストファイルの読み込み
お礼  yukko  - 04/1/5(月) 23:12 -

引用なし
パスワード
   JAKAさん
色々とありがとうございました。
 私の説明不足でご迷惑をかけました。
keinさんのを参考にします。
 ごめんなさい、また宜しくお願いします。

【10072】書いてきちゃったんで一応載っけときます...
回答  Jaka  - 04/1/6(火) 9:08 -

引用なし
パスワード
   >数値の内容ですがEXCELで読み込むと
>A
>10.5
>12.5
>8.5
>20.5
> とこんな感じでデ−タを読み込むのですが

[#1910]で、紹介したコードで、
「ファイルをカンマ区切りでセルに振分けますか?"」と、
聞かれたときに「いいえ」を選択すると、CSVファイルを1行づつ書き出すので、できたらそっちの方が良かったです。
ワードで開いても良いんですけど...。(40万行もあるファイルを開けるのか解りませんが。)

こんな感じに読み込んでいいのか良く解りませんけど。

Sub CSVRead()
  Dim OpenFile As String
  Dim TBL() As Variant, DataFlg As Boolean, DataCnt As Long
  Dim シート名 As String, 基シート名 As String, 増シート数 As Integer
  Dim WRow As Long, WCol As Long, ReadL As String
  Dim MaxR As Long, MaxL As Long
  Dim TBRow As Long, SRow As Integer
  Dim STime As Variant, ETime As Variant
  
  基シート名 = ActiveSheet.Name
  シート名 = 基シート名: 増シート数 = 0
  
  OpenFile = Application.GetOpenFilename("Excelファイル (*.csv), *.csv")
  If OpenFile <> "False" Then
    Open OpenFile For Input As #1
  Else
    End
  End If
  SRow = 5
  WRow = SRow
  MaxR = 3000
  MaxL = 144  '144列で改ページするようにしてあります。
  TBRow = 0
  WCol = 0
  ReDim TBL(1 To MaxR, 1 To 1)
  STime = Now()
  Do Until EOF(1)
    DataCnt = DataCnt + 1
    If DataCnt <= 5 Then
     Line Input #1, ReadL
    Else
     DataFlg = True
     TBRow = TBRow + 1
     Line Input #1, TBL(TBRow, 1)
     If TBRow = MaxR Then
       If WCol = MaxL Then
        Call 改ページ(基シート名, シート名, 増シート数)
        WCol = 1
       Else
        WCol = WCol + 1
       End If
       Sheets(シート名).Range(Cells(SRow, WCol), Cells(SRow + MaxR - 1, WCol)).Value = TBL
       ReDim TBL(1 To MaxR, 1 To 1)
       TBRow = 0
     End If
    End If
  Loop
  If DataFlg = True Then
    If WCol = MaxL Then
     Call 改ページ(基シート名, シート名, 増シート数)
     WCol = 1
    Else
     WCol = WCol + 1
    End If
    Sheets(シート名).Range(Cells(SRow, WCol), Cells(SRow + MaxR - 1, WCol)).Value = TBL
  End If
  Close #1
  Erase TBL
  MsgBox "計測タイム" & vbCrLf & Format(Now() - STime, "hh:mm:ss")
End Sub


Sub 改ページ(基シート名 As String, シート名 As String, 増シート数 As Integer)
  Dim 使用列数 As Integer, RR As Integer, II As Integer
  With Sheets(基シート名).UsedRange
     使用列数 = .Cells(.Count).Column
  End With
  For II = 1 To Worksheets.Count
    If ActiveSheet.Name = Worksheets(II).Name Then
      On Error Resume Next
      増シート数 = 増シート数 + 1
      Worksheets.Add after:=Worksheets(II)
      ActiveSheet.Name = 基シート名 & "_" & 増シート数
      シート名 = Worksheets(II + 1).Name
      Application.ScreenUpdating = False
      For RR = 1 To 使用列数
        With Sheets(シート名)
          .Columns(RR).NumberFormatLocal = Sheets(基シート名).Columns(RR).NumberFormatLocal
          .Columns(RR).ColumnWidth = Sheets(基シート名).Columns(RR).ColumnWidth
        End With
      Next
      Application.ScreenUpdating = True
      Worksheets(シート名).Select
      Exit Sub
    End If
  Next
End Sub

【10074】Re:書いてきちゃったんで一応載っけとき...
お礼  yukko  - 04/1/6(火) 10:27 -

引用なし
パスワード
    Jakaさん
ありがとうございました、参考にさせて頂きます。
 今後とも宜しくお願いします。

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