[[20211124063839]] 『タブ区切り出力が処理できない』(kenN) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『タブ区切り出力が処理できない』(kenN)

指定のセル範囲をタブ区切りでTEXTファイルに出力(保存)したいので
以下のようなコードを想定しましたが、空のTEXTしか保存されません。

1)多分、selectで指定したセル範囲がselectionで引き継がれないのが原因と思われます。
上手く引き継がれるようにするにはどうすれば良いですか ?

2)又、新しいブックを作成していますが
ブックを作成せずに処理する方法があれば教えて下さい。


Sub タブ区切り出力()

Dim fPath As String
Dim LSN As Double

'処理列の個数

 LSN = Cells(Rows.Count, "A").End(xlUp).Row

    'ファイル名を変数に格納
    fPath = "C:\Users\Ken\Desktop\Test.txt"

    Application.DisplayAlerts = False

    '出力セルを選択
    Range("D1", Cells(LSN, "F")).Select

    '新規ブック作成→出力するセルを新ブックのA1にコピー→保存→閉じる
    Workbooks.Add
    Selection.Copy ActiveSheet.Range("A1")

    ActiveWorkbook.SaveAs Filename:=fPath, FileFormat:=xlText
    ActiveWindow.Close

    Application.DisplayAlerts = True

End Sub

< 使用 Excel:Office365、使用 OS:Windows10 >


 >selectionで引き継がれないのが原因と思われます。
Workbooks.Addで
SelectionはActiveSheet.Range("A1")に変わったのではないのかな
予めコピーしておけばよいのでは
Range("D1", Cells(LSN, "F")).Copy
(どん) 2021/11/24(水) 06:52

 おはようございます ^^
既に、ご案内ですが、簡単な修正案そのX。。。^^;
変数rを用意[レンジ型、もしくはバリアント]

 Range("D1", Cells(LSN, "F")).Select
 Selection.Copy ActiveSheet.Range("A1")

 Set r = Range("D1", Cells(LSN, "F"))
 r.Copy ActiveSheet.Range("A1")

 2はこれでタブ区切りで出力されているなら[お望みの型式]。。。
よいのでは。。。(#^^#)
ま
直接書き出しも可能ですが。少々煩雑に。。。← 私だけかも^^;
m(__)m
(隠居Z) 2021/11/24(水) 07:17

 >ブックを作成せずに処理する方法があれば教えて下さい。
Sheets("シート名").Copy
で新規Bookにシートごとコピーされるので
後は不要なセルをクリアする
(どん) 2021/11/24(水) 07:29

 老婆心ながら。。。数式じゃないですよね。。。
Range("D1", Cells(LSN, "F")) の中身。。。^^;
( ̄▽ ̄)。。。m(_ _)m
(隠居Z) 2021/11/24(水) 07:50

ご参考。

https://www.google.com/search?q=vba+%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB+%E5%87%BA%E5%8A%9B&rlz=1C1GCEU_jaJP956JP957&oq=VBA%E3%80%80%E3%81%A6&aqs=chrome.4.69i57j0i4i512l6j69i61.9800j0j7&sourceid=chrome&ie=UTF-8

(ひまつぶし) 2021/11/24(水) 08:18


 私なら
 1.保存範囲を配列で取得
 2.Openステートメントで保存
http://officetanaka.net/excel/vba/file/file08.htm

 アドバイス
 Selectに頼るのは止めましょう。
 任意選択であれば有効ですが、本件ではデメリットしかないと思います。

(tkit) 2021/11/24(水) 08:36


ネットを参考に以下を考えましたが
出力はされますが、テキストファイルの中身が
改行だけです。

出来る範囲で修正をお願いします。

Sub 出力()

    Dim rUsed       As Range                '// UsedRange
    Dim r           As Range                '// Cell
    Dim fs          As New FileSystemObject '// FileSystemObject
    Dim ts          As TextStream           '// TextStream
    Dim sFilePath                           '// 出力ファイルパス
    Dim iRow                                '// 現在行
    Dim s                                   '// 出力文字列
    Dim LSN As Double

'処理列の個数

 LSN = Cells(Rows.Count, "A").End(xlUp).Row

    '// ファイルパス=ブックと同じフォルダ+シート名+.txt
    sFilePath = "C:\Users\Ken\Desktop\Audacity.txt"

    '// FileSystemObjectで新規ファイル作成
    Set ts = fs.CreateTextFile(sFilePath, True, False)

    '// ターゲットレンジを取得
    Set rUsed = Range("D2", Cells(LSN, "F"))

    iRow = 0

    '// 1セルずつループ
    For Each r In rUsed
        If iRow <> r.Row Then
            '// ループ初回時ではない場合
            If r.Row <> rUsed.Row Or r.Column <> rUsed.Column Then
                '// 行が変わったため改行コードを付与
                s = s & vbCrLf
            End If

            '// 行の先頭値を連結
            s = s & r.Text
        Else
            '// タブ文字区切りで連結
            s = s & vbTab & r.Text
        End If

        '// 現在行取得
        iRow = r.Row
    Next

    '// セルの文字列が存在する場合
    If s <> "" Then
        Call ts.WriteLine(s)
'        Call ts.Write(s)
'        Call ts.Write(vbCrLf)
    End If

    '// ファイルClose
    Call ts.Close
End Sub
(kenN) 2021/11/24(水) 08:40

すいません。

以下の記事が先に投稿されるはずが、投稿されていませんでした。

以下に変更して上手く処理出来たと思ったのですが
ヘッダー(見出し行)も出力されるので他の方法に変更中です。

Dim rng As Range
Dim LSN As Double

'処理列の個数

 LSN = Cells(Rows.Count, "A").End(xlUp).Row

    '■現在開いているブック情報をファイル名にするため、変数に格納
    fPath = "C:\Users\Nubo\Desktop\Audacity.txt"

    Application.DisplayAlerts = False

    '■現在選択しているセル情報をrngに格納
    Set rng = Range("D2", Cells(LSN, "F"))

    '■新規ブック作成→rngをA1にコピー→TSV保存→CSV閉じる
    Workbooks.Add
    rng.Copy ActiveSheet.Range("A1")
(kenN) 2021/11/24(水) 08:45

提案したので、コードを載せておきます。

 Sub sample()
     'パス指定
     Dim tsvPath As String
     tsvPath = "D:\TsvFile" & Format(Now(), "yyyymmddhhss") & ".tsv"

     'データ取得
     Dim lastRow As Long
     Dim saveData As Variant
     '▼冗長ですが、どのブック、どのシートかを意識付けすることが大事です
     With ActiveSheet
         lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
         saveData = .Range("D1", .Cells(lastRow, "F")).Value
     End With

     'データ整形
     Dim arr() As String
     Dim temp() As String
     Dim i As Long
     Dim ii As Long
     arr = Split("")
     For i = LBound(saveData, 1) To UBound(saveData, 1)
         temp = Split("")
         For ii = LBound(saveData, 2) To UBound(saveData, 2)
             ReDim Preserve temp(UBound(temp) + 1)
             temp(UBound(temp)) = saveData(i, ii)
         Next ii
         ReDim Preserve arr(UBound(arr) + 1)
         arr(UBound(arr)) = Join(temp, vbTab)
     Next i

     'データ保存
     Open tsvPath For Output As #1
         Print #1, Join(arr, vbCrLf)
     Close
 End Sub

(tkit) 2021/11/24(水) 09:34


tkitさん、回答ありがとうございます。

出力自体は問題なくできたのですが
配列を使用したコードは初心者には難解です。

また、セルの値が「秒」で表示を更に表示形式(FORMAT)で変更しています。
元の数値(秒)に戻すには、86400を掛け算する必要があるなど
複雑となるため今回は、以下を利用する事にしました。

Sub 出力()

Dim fPath As String
Dim fName As String
Dim rng As Range
Dim LSN As Double

'処理列の個数

 LSN = Cells(Rows.Count, "A").End(xlUp).Row

    '■現在開いているブック情報をファイル名にするため、変数に格納
    fPath = "C:\Users\Ken\Desktop\test.txt"

    Application.DisplayAlerts = False

    '■現在選択しているセル情報をrngに格納
    Set rng = Range("D1", Cells(LSN, "F"))

    '■新規ブック作成→rngをA1にコピー→TSV保存→CSV閉じる
    Workbooks.Add
    rng.Copy ActiveSheet.Range("A1")

    ActiveWorkbook.SaveAs Filename:=fPath, FileFormat:=xlText
    ActiveWindow.Close

    Application.DisplayAlerts = True

End Sub
(kenN) 2021/11/24(水) 10:30


 >複雑となるため今回は、以下を利用する事にしました。
 提示の新たなブックを開かない方法として提案したので、
 何を利用するかはお任せします。

 >元の数値(秒)に戻すには、86400を掛け算する必要がある
 取得時の.Valueを.Textにすればいいだけですよ。

(tkit) 2021/11/24(水) 11:04


既に提案のあるところですが、難しく考えず普通にテキストファイルに出力すればよいだけでは?
    Sub 研究用()
        Dim FN As Long, i As Long

        Stop 'ブレークポイントの代わり

        FN = FreeFile

        Open "C:\Users\Ken\Desktop\Test.txt" For Output As #FN

        With ActiveSheet
            For i = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
                Print #FN, .Cells(i, "D").Text & vbTab & .Cells(i, "E").Text & vbTab & .Cells(i, "F").Text
            Next i
        End With
        Close #FN
    End Sub

(もこな2) 2021/11/24(水) 12:45


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.