[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『大容量のファイルの保存の仕方』（えふ）
エクセルで表示可能な範囲を超えたファイル（１０万行くらいある）を開き、 表示できる分だけでいいので保存したのですが、そのままの作業では重いのでいくつかのシートに分けたいと思います。 ２０００行程度ずつのシートに分けたいのですが、どうやったらできますか？ 選択して切り取ってやってみましたが、とんでもなく大変で・・。 何か簡単な方法を知っていたら教えてください。 また、保存できなかった残りのファイルは開くことは不可能でしょうか？ よろしくお願いします。
↓で作成したマクロの焼き直し版です。 [[20031110104543]] 『CSVって何行までできますか』（わい） Sub CSV_Inport() Const MyLimit As Long = 2000: Rem 取込行数 Const Fname As String = "C:\sample.csv": Rem 取込ファイル名 Dim Buffer As String Dim SNum As Long, CHK As Long Dim Ws As Worksheet, TEMP As Variant SNum = 0 CHK = 0 Open Fname For Input Access Read As #1 Set Ws = Worksheets.Add While Not EOF(1) Line Input #1, Buffer CHK = CHK + 1 TEMP = Split(Buffer, ",") Ws.Cells(CHK - (SNum) * MyLimit, 1).Resize(1, UBound(TEMP) + 1).Value = TEMP If CHK = (SNum) * MyLimit + MyLimit Then Set Ws = Worksheets.Add SNum = SNum + 1 End If Wend Close #1 Set Ws = Nothing End Sub (みやほりん)(-_∂)b
terapadを普段から使っているのでterapadを使用しました。
開く時、terapadから開こうとするとCSVファイルが表示されず開けないので、
ファイルを選択してからデスクトップ上のterapadアイコンへドラッグドロップしたらできました。
が、terapadからは開けないのでしょうか？
あと、terapadでページを分ける作業したあと保存する際、CSVファイルの選択ができなかったので、手入力で”.csv”と入れたらエクセルで開くことができましたが、他にもっと簡単な方法はないでしょうか？
かなりたくさんのページを保存することになるので、手入力は大変なので・・・。
どなたかもし知っていましたら教えてください。お願いします。
（注意点） 固定長ファイルで、バイト数をあわせるのに半角スペースなどが左側に 使われているとダメです。 Inputで読みこむと半角スペースが削られるから。 例 aaaaaaa, bbbbb, ccccc ↓ aaaaaaa,bbbbb,ccccc こんな感じのものとして扱われます。 (Jaka)
Option Base 1
Sub CSVファイル読込()
Dim シート名 As String, 基シート名 As String, 処理CNT As Long, CSV全データ行数 As Long
Dim 書始め行 As Long, 増シート数 As Integer, 行 As Long, 列位置 As Integer
Dim TBL() As String, カンマ数 As Integer, TBL行数 As Long, TBL行CNT As Long, 拡張子 As String
Dim ReadData As String, 設定行 As Long, 設定列 As Long, バーお知らせ As String
Dim 基本TBL行数 As Long, 使用TBL行数 As Long, 終了flg As Integer, 改シート行flg As Integer
Dim 書込み最終行設定 As Long, 書込み有効残数 As Long, シート最終行入力 As String, 追加枚数 As Integer
Dim 振分け As Variant, 振分け2 As Variant, STime As Variant, ETime As Variant
Dim I As Long, WクォFlg As Byte, DoEvCnt As Long
基シート名 = ActiveSheet.Name
シート名 = 基シート名: 増シート数 = 0: 改シート行flg = 0
CSV全データ行数 = 0: バーお知らせ = "行目から ": 終了flg = 0: カンマ数 = 0: DoEvCnt = 0
基本TBL行数 = 500: TBL行CNT = 0: 処理CNT = 0: 改シートflg = 0: WクォFlg = 0
オープンファイル = Application.GetOpenFilename("Excelファイル (*.csv;*.txt), *.csv;*.txt")
If オープンファイル <> False Then
拡張子 = StrConv(Right(オープンファイル, 3), vbUpperCase)
Open オープンファイル For Input As #1
Else
End
End If
'書込み形式入力
Line Input #1, ReadData
振分け = MsgBox(拡張子 & "ファイルをカンマ区切りでセルに振分けますか？" & vbCrLf & vbCrLf & _
"振分けずに1列に読込むなら「いいえ」を。" & vbCrLf & vbCrLf & _
"中止するならキャンセルを選択してください。", vbQuestion + vbYesNoCancel, 拡張子 & _
"ファイル読込形式")
If 振分け = vbYes Then
For I = 1 To Len(ReadData)
If Mid(ReadData, I, 1) = "," And WクォFlg = 0 Then
カンマ数 = カンマ数 + 1
ElseIf Mid(ReadData, I, 1) = Chr(34) And WクォFlg = 0 Then
WクォFlg = 1
ElseIf Mid(ReadData, I, 1) = Chr(34) And WクォFlg = 1 Then
WクォFlg = 0
End If
Next
If カンマ数 = 0 Then
振分け2 = MsgBox("１行目データを見た所、区切りのカンマが全くありません。" & Chr(13) & _
"強行しますか？", vbExclamation + vbYesNo, "カンマエラー")
If 振分け2 = vbNo Then
Close #1
End
End If
ElseIf カンマ数 > 100 Then
基本TBL行数 = 100
ElseIf カンマ数 > 50 Then
基本TBL行数 = 200
End If
ElseIf 振分け = vbNo Then
基本TBL行数 = 15000
Else
Close #1
End
End If
Close #1
ReadData = Empty
Open オープンファイル For Input As #1
Do Until EOF(1)
Line Input #1, ReadData
CSV全データ行数 = CSV全データ行数 + 1
Loop
Close #1
DoEvents
'シート最終行（改ページ行）入力
書込み最終行設定 = Cells(Rows.Count, 1).Row
Do
シート最終行入力 = Application.InputBox(Prompt:=拡張子 & "全データ行数は、" & CSV全データ行数 & "行有りました。" & _
vbCrLf & vbCrLf & "書込み最終行（改ページ行）を入力して下さい。", _
Title:="書込み最終行（改ページ行）入力", Default:=書込み最終行設定)
If シート最終行入力 = "False" Then
End
ElseIf Not (IsNumeric(シート最終行入力)) Then
MsgBox "数字を入力して下さい。", vbExclamation, "入力エラー"
ElseIf シート最終行入力 < 1 Or シート最終行入力 > 書込み最終行設定 Then
MsgBox "最終行（改ページ行）は、1～" & 書込み最終行設定 & "の間までです。", vbExclamation, "入力エラー"
Else
書込み最終行設定 = Int(シート最終行入力)
Exit Do
End If
Loop
Do
Call 書込み開始位置設定(設定行, 設定列)
If 設定行 > 書込み最終行設定 Then
MsgBox "書込み最終行（改ページ行）" & "行より下行を" & vbCrLf & _
"書込み開始行とすることはできません。", vbExclamation, "開始位置設定エラー"
ElseIf CSV全データ行数 / (書込み最終行設定 - (設定行 - 1)) + Worksheets.Count - 1 > 50 Then
追加枚数 = CSV全データ行数 / (書込み最終行設定 - (設定行 - 1)) - 1
中止有無 = MsgBox("現在のシート枚数 " & Worksheets.Count & " 枚、追加されるシート枚数 " & 追加枚数 & " 枚。" & vbCrLf & _
vbCrLf & "全シート枚数が50枚を超えます。" & vbCrLf & vbCrLf & "書き始め行と書込み最終行（改シート行）を設定を変えますか？" & _
vbCrLf & vbCrLf & "見なおす場合は、一旦終了します。", vbExclamation + vbYesNo, "シート追加枚数警報")
If 中止有無 = vbYes Then
End
Else
Exit Do
End If
Else
Exit Do
End If
Loop
書始め行 = 設定行
行 = 書始め行
書始め列 = 設定列
'初期TBL行数設定
書込み有効残数 = 書込み最終行設定 - (書始め行 - 1)
If 書込み有効残数 < 基本TBL行数 Then
基本TBL行数 = 書込み有効残数
ElseIf CSV全データ行数 <= 基本TBL行数 Then
基本TBL行数 = CSV全データ行数
終了flg = 1
End If
TBL行数 = 基本TBL行数
ReDim TBL(TBL行数, カンマ数 + 1)
Application.DisplayStatusBar = True
'Application.ScreenUpdating = False
Application.Calculation = xlManual
STime = Now()
Open オープンファイル For Input As #1
Do Until EOF(1)
処理CNT = 処理CNT + 1
TBL行CNT = TBL行CNT + 1
'セル列方向TBL転記
If カンマ数 = 0 Then
Line Input #1, TBL(TBL行CNT, カンマ数 + 1)
Else
For I = 1 To カンマ数 + 1
Input #1, TBL(TBL行CNT, I)
Next
End If
If TBL行CNT = TBL行数 Or EOF(1) Then
Application.StatusBar = 拡張子 & "全データ " & CSV全データ行数 & "行中、" & Format(処理CNT, "000000") & "行目読込み後、" & _
シート名 & "に " & 行 & バーお知らせ & TBL行数 & "行の書込み中"
ActiveWorkbook.Worksheets(シート名).Range(Cells(行, 書始め列), Cells(行 + TBL行数 - 1, 書始め列 + カンマ数)).Value = TBL
DoEvCnt = DoEvCnt + 1
DoEvents
TBL行CNT = 0
行 = 行 + TBL行数
書込み有効残数 = 書込み有効残数 - TBL行数
If 終了flg = 1 Then
Exit Do
End If
If CSV全データ行数 - 処理CNT > 0 Then
'改ページ
If 書込み有効残数 = 0 Then
Call TBL使用シート増(基シート名, シート名, 増シート数, 設定行, 設定列)
DoEvents
行 = 書始め行
書込み有効残数 = 書込み最終行設定 - (書始め行 - 1)
If CSV全データ行数 - 処理CNT < TBL行数 Then
TBL行数 = CSV全データ行数 - 処理CNT
Else
TBL行数 = 基本TBL行数
End If
ElseIf 書込み有効残数 < TBL行数 Then
TBL行数 = 書込み有効残数
ElseIf CSV全データ行数 - 処理CNT < TBL行数 Then
TBL行数 = CSV全データ行数 - 処理CNT
Else
TBL行数 = 基本TBL行数
End If
Else
終了flg = 1
End If
ReDim TBL(TBL行数, カンマ数 + 1)
End If
Loop
Close #1
Erase TBL
ETime = Now()
Application.Calculation = xlAutomatic
DoEvents
Application.StatusBar = 拡張子 & "全データ " & CSV全データ行数 & "行中、" & Format(処理CNT, "000000") & "行の処理終了しました。"
Application.DisplayStatusBar = False
MsgBox "終わりました。" & vbLf & "TBL行数" & 基本TBL行数 & vbCrLf & STime & "-" & ETime & "=" & Format(ETime - STime, "hh:mm:ss")
End Sub
Sub TBL使用シート増(基シート名 As String, シート名 As String, 増シート数 As Integer, 設定行 As Long, 設定列 As Long)
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
Function 書込み開始位置設定(設定行, 設定列) As Long
Dim エラー番号 As Integer
Dim 入力始点位置set As Object
On Error Resume Next
Set 入力始点位置set = Application.InputBox(Prompt:="書込む最初のセルをクリックして下さい。", _
Title:="書込み位置の選択", Default:=ActiveCell.Address, Type:=8)
If 入力始点位置set Is Nothing Then
入力始点位置set = Nothing
End
Else
設定行 = 入力始点位置set.Row
設定列 = 入力始点位置set.Column
End If
入力始点位置set = Nothing
End Function
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.