Excel VBA質問箱 IV

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

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


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

【17887】72桁ごとに分けてセルに入力したい しゃけ 04/9/9(木) 16:40 質問[未読]
【17890】Re:72桁ごとに分けてセルに入力したい IROC 04/9/9(木) 17:10 回答[未読]
【17900】Re:72桁ごとに分けてセルに入力したい Hirofumi 04/9/9(木) 20:04 回答[未読]
【17912】Re:72桁ごとに分けてセルに入力したい しゃけ 04/9/10(金) 10:06 発言[未読]

【17887】72桁ごとに分けてセルに入力したい
質問  しゃけ  - 04/9/9(木) 16:40 -

引用なし
パスワード
   こんにちは。
1行が数万桁のファイルを72桁ごとに分けてセルに入力したいのですが
行き詰まってしました。どうかお知恵をお貸しいただけないでしょうか。

以下のまま実行するとセルに入りきらないので分けたいのですが・・・。

  Dim xPos As Long, yPos As Integer, fNo As Integer
  Dim sName As String, fText As String
  ---略---
  ThisWorkbook.Worksheets(sName).Cells(yPos, xPos) = "'" & fText
  yPos = yPos + 1
  If yPos > 65536 Then
    yPos = 1
    xPos = xPos + 1
  End If

【17890】Re:72桁ごとに分けてセルに入力したい
回答  IROC  - 04/9/9(木) 17:10 -

引用なし
パスワード
   >1行が数万桁のファイル

何ファイルですか?

【17900】Re:72桁ごとに分けてセルに入力したい
回答  Hirofumi  - 04/9/9(木) 20:04 -

引用なし
パスワード
   'こんなので善いのかな?
'基本的には、BinaryモードでInputB関数で読み込みます
'データが書き込まれるWorkSheetは、Upしたコードではアクティブシートです
'検証不足なので上手くいかなかったらゴメン

Option Explicit

Public Sub ReadFixdText()

  Dim wksWrite As Worksheet
  Dim lngRecLen As Long
  Dim lngLineMax As Long
  Dim vntFileName As Variant
  Dim lngWriteRow As Long
  Dim lngWriteCol As Long

  'ディフォルトのファイル名を指定
  vntFileName = "TestFile.txt"
  If Not GetReadFile(vntFileName, ThisWorkbook.Path, False) Then
    Exit Sub
  End If
  'Openするファイル名を設定
'  vntFileName = ThisWorkbook.Path & "\" & "TestFile.txt"
  If Dir(vntFileName) = "" Then
    Beep
    MsgBox vntFileName & vbCrLf & "ファイルが有りません"
    Exit Sub
  End If

  '画面更新を停止
  Application.ScreenUpdating = False
  
  '書き込み行の初期値を設定
  lngWriteRow = 1
  '書き込み列の初期値を設定
  lngWriteCol = 1
  '書き込むシート名の参照を設定
  Set wksWrite = ActiveSheet
  
  'フィールド長の設定
  lngRecLen = 72
  
  '総行数確認
  lngLineMax = FileLen(vntFileName) \ lngRecLen
  If lngLineMax + lngWriteRow > 65536 Then
    Beep
    MsgBox "Dataが" & lngLineMax & _
      "行有り、65536行を超えています", _
          vbExclamation + vbOKOnly, "OverFlow"
    Exit Sub
  End If
  
  'ファイルの読み込み
  SDFRead vntFileName, lngRecLen, _
      wksWrite, lngWriteRow, lngWriteCol
    
  Set wksWrite = Nothing
  
  '画面更新を再開
  Application.ScreenUpdating = True
    
  Beep
  MsgBox "処理が終了しました", vbOKOnly, "終了"
    
End Sub

Private Sub SDFRead(ByVal strFileName As String, _
          lngRecLen As Long, _
          ByVal wksWrite As Worksheet, _
          Optional lngRow As Long = 2, _
          Optional lngCol As Long = 1)

  'lngRow = 2 : シートのデータ書き込み先頭行位置
  'lngCol = 1 : シートのデータ書き込み先頭列位置
  
  Dim dfn As Integer
  Dim vntField As Variant

  '読み込むファイルをBinaryファイルとしてOpen
  dfn = FreeFile
  Open strFileName For Binary Access Read As dfn

  '最終バイト数まで繰り返す
  Do Until LOF(dfn) <= Loc(dfn)
    'フィールドData作成
    vntField = StrConv(InputB(lngRecLen, #dfn), vbUnicode)
    'List書きこみ
    wksWrite.Cells(lngRow, lngCol).Value = vntField
    '書き込み行の更新
    lngRow = lngRow + 1
  Loop

  Close #dfn

End Sub

Public 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, False
  End If
  
  vntFileNames _
      = Application.GetOpenFilename(strFilter, 2, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【17912】Re:72桁ごとに分けてセルに入力したい
発言  しゃけ  - 04/9/10(金) 10:06 -

引用なし
パスワード
   ▼Hirofumi さん:
>'こんなので善いのかな?
>'基本的には、BinaryモードでInputB関数で読み込みます
>'データが書き込まれるWorkSheetは、Upしたコードではアクティブシートです
>'検証不足なので上手くいかなかったらゴメン

ありがとうございます。
いま確認しています。
動きは大丈夫なようですが、途中でエラーがでてしまいますので調べています。
扱いたいファイルに、Null文字というものが含まれておりそれが原因ではないかと思うのですが・・・。

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