| |
▼Hirofumi さん：
天才ですね！！！！！
あとは自分のほしい形に直してみます。
また壁にぶちあたったらコメントお願いします。
ありがとうございました！
>>Excel初心者です。
>>今大学の研究で3,000,000行×4列のテキストファイルを、50,000×4列に分けて横に60個並べて読み込もうとしているんですが、どうしたらいいかわかりません。
>>
>>助言お願いします。
>>
>>あと2002を使っています。
>
>如何しても、やって見るなら
>Csvで4列×3,000,000行で下記の様なデータ
>
>11903.57 15449.86 .000 .647
>11826.67 15412.91 .000 5.266
>11764.66 15382.12 2.974 5.266
>11705.12 15345.17 .000 5.266
>
>なら、時間が掛かりますが何とか行けるかも？
>Vista 2.3G メモリ2G Excel2007で約60秒ぐらいかな？
>
>Option Explicit
>
>Public Sub ReadCsvExt()
>
>' 指定行数分出力版(データ抽出)
>
> '出力行数のサイズを設定
> Const clngOutputSize = 50000
>
> Dim lngWrite As Long
> Dim lngRow As Long
> Dim lngColumn As Long
> Dim lngColumns As Long
> Dim rngResult As Range
> Dim vntResult() As Variant
> Dim vntFilename As Variant
> Dim dfn As Integer
> Dim strBuff As String
> Dim strRec As String
> Dim blnMulti As Boolean
> Dim strPrompt As String
>
> Dim sngTime1 As Single
> Dim sngTime2 As Single
>
> '結果用配列の列初期値を設定
> lngColumns = 3
>
> If Not GetReadFile(vntFilename, ThisWorkbook.Path) Then
> strPrompt = "マクロがキャンセルされました"
> GoTo Wayout
> End If
>
> sngTime2 = Timer
>
> '結果出力位置の指定
> Set rngResult = ActiveSheet.Range("A1")
>
> '画面更新を停止
> Application.ScreenUpdating = False
>
> '空きファイルバファ番号を取得
> dfn = FreeFile
> 'ファイルをInputモードでOpen
> Open vntFilename For Input As dfn
>
> ReDim vntResult(1 To clngOutputSize, lngColumns)
> Do Until EOF(dfn)
> 'ファイルより、1行読み込み
> Line Input #dfn, strBuff
> '論理レコードに物理レコードを追加
> strRec = strRec & strBuff
> '出力用配列を作成
> lngRow = lngRow + 1
> SplitCsv strRec, vntResult, lngRow, lngColumns, vbCrLf, blnMulti
> If blnMulti Then
> lngRow = lngRow - 1
> strRec = strRec & vbLf
> Else
> strRec = ""
> '★抽出条件（抽出の場合以下のコメントアウトを活かす）
>' If (Val(vntResult(lngRow, 0)) <= 12000 _
>' Or 15000 <= Val(vntResult(lngRow, 0))) _
>' Or (Val(vntResult(lngRow, 1)) <= 17000 _
>' Or 19000 <= Val(vntResult(lngRow, 1))) Then
>' lngRow = lngRow - 1
>' End If
> End If
> If lngRow = clngOutputSize Then
> '結果をシートに出力
> rngResult.Offset(lngWrite, lngColumn).Resize(lngRow, _
> lngColumns + 1).Value = vntResult
> lngColumn = lngColumn + 4
> lngRow = 0
> End If
> Loop
>
> 'ファイルを閉じる
> Close #dfn
>
> '文字列バファにデータが残っている場合、配列に出力
> If lngRow > 0 Then
> '結果をシートに出力
> rngResult.Offset(lngWrite, lngColumn).Resize(lngRow, lngColumns + 1).Value = vntResult
> End If
>
> strPrompt = "処理が完了しました"
>
>Wayout:
>
> '画面更新を再開
> Application.ScreenUpdating = True
>
> Set rngResult = Nothing
>
> sngTime1 = Timer
>
> MsgBox strPrompt & vbLf & (sngTime1 - sngTime2), vbInformation
>
>End Sub
>
>Private Sub SplitCsv(strLine As String, _
> vntData() As Variant, _
> lngRow As Long, _
> lngColumns As Long, _
> strRet As String, _
> Optional blnMulti As Boolean)
>
> Const strDelimiter As String = ","
> Const strQuote As String = """"
>
> Dim i As Long
> Dim lngDPos As Long
> Dim lngStart As Long
> Dim lngEnd As Long
> Dim strField As String
> Dim lngRowMax As Long
> Dim strTmp As String
>
> lngRowMax = UBound(vntData, 1)
>
> '配列の添え字の初期値
> i = 0
> 'Delimiter探索の開始位置
> lngStart = 1
> '分割元の文字列の長さ
> lngEnd = Len(strLine)
> '複数行Flagを初期化
> blnMulti = False
> '探索開始位置が分割元の文字列の長さを超えるまで分割
> Do
> 'もし、開始位置の文字がstrQuoteと違う場合
> If Mid$(strLine, lngStart, 1) <> strQuote Then
> 'Delimiterの位置を取得
> lngDPos = InStr(lngStart, strLine, strDelimiter, vbBinaryCompare)
> 'Delimiterがある場合
> If lngDPos > 0 Then
> '開始位置からDelimiterの前までを取得
> strField = Mid$(strLine, lngStart, lngDPos - lngStart)
> '開始位置をDelimiterの後ろに更新
> lngStart = lngDPos + 1
> Else
> '開始位置以降を取得
> strField = Mid$(strLine, lngStart)
> '開始位置を分割元の文字列の長さを超える位置に
> lngStart = lngEnd + 1
> End If
> '開始位置の文字がstrQuoteと同じ場合
> Else
> '開始位置をstrQuoteの後ろに設定
> lngStart = lngStart + 1
> Do
> 'strQuoteの位置を取得
> lngDPos = InStr(lngStart, strLine, strQuote, vbBinaryCompare)
> 'strQuoteがある場合
> If lngDPos > 0 Then
> '取得済みの文字列にstrQuote以降の文字列を加算
> strField = strField & Mid$(strLine, lngStart, lngDPos - lngStart)
> '開始位置をstrQuote以降に更新
> lngStart = lngDPos + 1
> '分割元の文字列の開始位置から１文字取得し
> strTmp = Mid$(strLine, lngStart, 1)
> 'Delimiterなら
> If strTmp = strDelimiter Then
> '開始位置を１つ進める
> lngStart = lngStart + 1
> 'Doを抜ける
> Exit Do
> '空白の文字列なら
> ElseIf strTmp = "" Then
> 'Doを抜ける
> Exit Do
> 'strQuoteなら
> ElseIf strTmp = strQuote Then
> '開始位置を１つ進める
> lngStart = lngStart + 1
> '取得済みの文字列にstrQuoteを加算
> strField = strField & strQuote
> End If
> 'strQuoteが無い場合
> Else
> '複数行Flagを立てる
> blnMulti = True
> strField = Mid$(strLine, lngStart) & strRet
> '開始位置を分割元の文字列の長さを超える位置に
> lngStart = lngEnd + 1
> 'Doを抜ける
> Exit Do
> End If
> Loop
> End If
> '配列を確保
> If i > lngColumns Then
> lngColumns = lngColumns + 1
> ReDim Preserve vntData(1 To lngRowMax, lngColumns)
> End If
> '配列に取得文字列を代入
> vntData(lngRow, i) = strField
> '取得文字列を初期化
> strField = ""
> '配列の添え字を更新
> i = i + 1
> Loop Until lngEnd < lngStart
>
>End Sub
>
>Private Function GetReadFile(vntFileNames As Variant, _
> Optional strFilePath As String, _
> Optional blnMultiSel As Boolean _
> = False) As Boolean
>
> Dim strFilter As String
>
> 'フィルタ文字列を作成
> strFilter = "CSV File (*.csv),*.csv," _
> & "Text File (*.txt),*.txt," _
> & "CSV and Text (*.csv; *.txt),*.csv;*.txt," _
> & "全て (*.*),*.*"
> '読み込むファイルの有るフォルダを指定
> If strFilePath <> "" Then
> 'ファイルを開くダイアログ表示ホルダに移動
> ChDrive Left(strFilePath, 1)
> ChDir strFilePath
> End If
> 'もし、ディフォルトのファイル名が有る場合
> If vntFileNames <> "" Then
> SendKeys vntFileNames & "{TAB}", False
> End If
> '「ファイルを開く」ダイアログを表示
> vntFileNames _
> = Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
> If VarType(vntFileNames) = vbBoolean Then
> Exit Function
> End If
>
> GetReadFile = True
>
>End Function
|
|
黄身
- 09/11/29(日) 5:42 -
