| |
>数値の内容ですがＥＸＣＥＬで読み込むと
>Ａ
>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
|
|
Jaka
- 04/1/6(火) 9:08 -
