[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『タブ区切り出力が処理できない』(kenN)
指定のセル範囲をタブ区切りでTEXTファイルに出力(保存)したいので
以下のようなコードを想定しましたが、空のTEXTしか保存されません。
1)多分、selectで指定したセル範囲がselectionで引き継がれないのが原因と思われます。
上手く引き継がれるようにするにはどうすれば良いですか ?
2)又、新しいブックを作成していますが
ブックを作成せずに処理する方法があれば教えて下さい。
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
(ひまつぶし) 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
出力自体は問題なくできたのですが
配列を使用したコードは初心者には難解です。
また、セルの値が「秒」で表示を更に表示形式(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.