Excel VBA質問箱 IV

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

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


71156 / 76732 ←次へ | 前へ→

【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

2 hits

【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 お礼

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