エクセルVBAの質問です。

セルB1から始まるセル範囲とセルB9から始まるセル範囲をセミコロン区切りにし、尚かつ各行の最後にもセミコロンを追加し一つのテキストファイル(.txt)として出力するマクロをどなたかご教授いただけないでしょうか。前述の二つのセル範囲の間には必ず空白行が存在します。そのまま使えるマクロをご提供くださった方にお気持ちですが、500ポイント差し上げたいと思います。宜しくお願いいたします。

回答の条件
  • 1人5回まで
  • 登録:2009/10/01 16:06:15
  • 終了:2009/10/01 16:57:53

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/10/01 16:48:14

ポイント500pt
Sub test()
    Dim r As Range
    Dim s As String
    Dim i As Long
    Dim intF As Integer
    
    intF = FreeFile
    i = 1
    For Each r In Range("B1").CurrentRegion
        If r.Row = i Then
            s = s & r.Value & ";"
        Else
            s = s & vbNewLine & r.Value & ";"
            i = r.Row
        End If
    Next r
    
    For Each r In Range("B9").CurrentRegion
        If r.Row = i Then
            s = s & r.Value & ";"
        Else
            s = s & vbNewLine & r.Value & ";"
            i = r.Row
        End If
    Next r
    
    Open ThisWorkbook.Path & "\res.txt" For Output As #intF
    Print #intF, s
    Close #intF
End Sub
id:tororosoba

SALINGERさん、ありがとうございました。確認させていただきました!緊急でしたので、非常に助かりました!

2009/10/01 16:57:40

その他の回答(1件)

id:HALSPECIAL No.1

HALSPECIAL回答回数407ベストアンサー獲得回数862009/10/01 16:33:16

ポイント100pt

こちらでいかがでしょうか?

Option Explicit

Private Const OUTPUT_FILE As String = "D:\hoge.txt"  '出力ファイル名
Private Const RANGE_AREA As String = "B1:B9"
Private Const SPACE_COL_PASS_FLAG As Boolean = False    'スペース行を飛ばす場合はTrueにする

Public Sub ファイル出力()
    Dim fso, f
    Dim c As Range
    Dim line As String
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.CreateTextFile(OUTPUT_FILE, True)

    For Each c In ActiveSheet.Range(RANGE_AREA)
        If SPACE_COL_PASS_FLAG Then
            If c.Value <> "" Then
            line = line & c.Value & ";"
            End If
        Else
            line = line & c.Value & ";"
        End If
    Next c
    
    f.WriteLine line
    f.Close
    Set f = Nothing
    Set fso = Nothing
End Sub


id:tororosoba

HALSPECIALさん、いつもありがとうございます。

私の説明不足で大変に申し訳ございません。実際は以下のようなテキストの出力を希望しております。

お教えいただけると助かります・・。

エクセルシート

   A  B  C  D

1     50  50  50

2    50  50  50

   A  B  C  D

9     40  40  40

10    40  40  40

テキストファイル中身

50;50;50;

50;50;50;

40;40;40;

40;40;40;

2009/10/01 16:45:21
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/10/01 16:48:14ここでベストアンサー

ポイント500pt
Sub test()
    Dim r As Range
    Dim s As String
    Dim i As Long
    Dim intF As Integer
    
    intF = FreeFile
    i = 1
    For Each r In Range("B1").CurrentRegion
        If r.Row = i Then
            s = s & r.Value & ";"
        Else
            s = s & vbNewLine & r.Value & ";"
            i = r.Row
        End If
    Next r
    
    For Each r In Range("B9").CurrentRegion
        If r.Row = i Then
            s = s & r.Value & ";"
        Else
            s = s & vbNewLine & r.Value & ";"
            i = r.Row
        End If
    Next r
    
    Open ThisWorkbook.Path & "\res.txt" For Output As #intF
    Print #intF, s
    Close #intF
End Sub
id:tororosoba

SALINGERさん、ありがとうございました。確認させていただきました!緊急でしたので、非常に助かりました!

2009/10/01 16:57:40

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません