Excel VBA質問箱 IV

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

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


72869 / 76738 ←次へ | 前へ→

【8351】Re:Hirofumiさんまた教えて!!
回答  Hirofumi E-MAIL  - 03/10/9(木) 21:42 -

引用なし
パスワード
   ウームこう成るとファイルの入力も、出力も、
多分、上から順番にベタベタと書き並べるだけですね

ファイル出力用コード2つ、シート読み込み用コード2つは書き換えに成ります
尚、以下の5つのコードは前回と修正変更は有りませんので共通に使えます
Private Function ComposeLine
Private Function PrepareCsvField
Private Function GetWriteFile
Private Function SplitCsv
Private Function GetReadFile

まず、前回と別の標準モジュールをプロジェクトに追加して下さい
以下のコードを記述して下さい
前回のモジュールから、以下の5つのプロシージャを、
今回の標準モジュールにCopyしてきて下さい

ファイル出力用コードの
Private Function ComposeLine
Private Function PrepareCsvField
Private Function GetWriteFile

シート読み込み用コード
Private Function SplitCsv
Private Function GetReadFile

'ファイル出力用コード
Public Sub WriteCsvSequ2()

  Dim vntFileName As Variant
  Dim wksRead As Worksheet
  
  '出力名を取得します
  If Not GetWriteFile(vntFileName, ThisWorkbook.Path) Then
    Exit Sub
  End If
  
  '出力するシートの参照を設定
  Set wksRead = ActiveSheet
  
  'ファイルに出力
  CsvWrite vntFileName, wksRead
  
  '読み込むシートの参照を破棄
  Set wksRead = Nothing
  
  Beep
  MsgBox "処理が終了しました", vbOKOnly, "終了"

End Sub

Private Sub CsvWrite(ByVal strFileName As String, _
            ByVal wksRead As Worksheet)

  Dim dfn As Integer
  Dim i As Long
  Dim vntField As Variant
    
  '空きファイル番号を取得します
  dfn = FreeFile
  '出力ファイルをOpenします
  Open strFileName For Output As dfn
    
  With wksRead
    'B3の出力
    Print #dfn, PrepareCsvField(.Cells(3, 2).Value)
    'D5〜N63の出力
    With .Cells(5, 4)
      For i = 0 To 58
        '1行分のDataをシートから読みこむ
        vntField = Range(.Offset(i), .Offset(i, 10)).Value
        '出力1レコード作成、書き出し
        Print #dfn, ComposeLine(vntField, ",")
      Next i
    End With
    'G209〜G216の出力
    With .Cells(209, 7)
      For i = 0 To 7
        Print #dfn, PrepareCsvField(.Offset(i).Value)
      Next i
    End With
    'E218〜E220、G218〜G220の出力
    With .Cells(218, 5)
      For i = 0 To 2
        Print #dfn, PrepareCsvField(.Offset(i).Value) _
            & "," & PrepareCsvField(.Offset(i, 2).Value)
      Next i
    End With
  End With
  
  '出力ファイルを閉じる
  Close #dfn
  
End Sub

'シート読み込み用コード
Public Sub ReadCsvSequ2()

  Dim vntFileName As Variant
  Dim wksWrite As Worksheet
  
  '読み込むファイル名を取得
  If Not GetReadFile(vntFileName, ThisWorkbook.Path) Then
    Exit Sub
  End If
  
  '書き込むシートの参照を設定
  Set wksWrite = ActiveSheet
  
  'ファイルを読み込みシートに書き込む
  CSVRead vntFileName, wksWrite
  
  '書き込むシートの参照を破棄
  Set wksWrite = Nothing
  
  Beep
  MsgBox "処理が終了しました", vbOKOnly, "終了"
 
End Sub

Private Sub CSVRead(ByVal strFileName As String, _
              ByVal wksWrite As Worksheet)
  
  Dim i As Long
  Dim dfn As Integer
  Dim vntField As Variant
  Dim strLine As String
  
  '空きファイル番号を取得します
  dfn = FreeFile
  'ファイルをInputモードでOpen
  Open strFileName For Input As dfn
  
  With wksWrite
    'B3の出力
    Line Input #dfn, strLine
    vntField = SplitCsv(strLine, ",")
    .Cells(3, 2).Value = vntField(0)
    'D5〜N63の出力
    With .Cells(5, 4)
      For i = 0 To 58
        Line Input #dfn, strLine
        vntField = SplitCsv(strLine, ",")
        '1行分の出力
        Range(.Offset(i), .Offset(i, 10)).Value _
                          = vntField
      Next i
    End With
    'G209〜G216の出力
    With .Cells(209, 7)
      For i = 0 To 7
        Line Input #dfn, strLine
        vntField = SplitCsv(strLine, ",")
        .Offset(i).Value = vntField(0)
      Next i
    End With
    'E218〜E220、G218〜G220の出力
    With .Cells(218, 5)
      For i = 0 To 2
        Line Input #dfn, strLine
        vntField = SplitCsv(strLine, ",")
        .Offset(i).Value = vntField(0)
        .Offset(i, 2).Value = vntField(1)
      Next i
    End With
  End With
  
  Close #dfn
  
End Sub
0 hits

【8305】Hirofumiさんまた教えて!! ちっくん 03/10/7(火) 23:51 質問
【8314】Re:Hirofumiさんまた教えて!! おせっかいくん 03/10/8(水) 11:43 発言
【8322】Re:Hirofumiさんまた教えて!! Hirofumi 03/10/8(水) 19:35 発言
【8327】Re:Hirofumiさんまた教えて!! ちっくん 03/10/8(水) 22:19 回答
【8351】Re:Hirofumiさんまた教えて!! Hirofumi 03/10/9(木) 21:42 回答
【8368】Re:Hirofumiさんまた教えて!! ちっくん 03/10/10(金) 20:38 お礼

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