秒に.000000を追加した形式

質問

結合されたMP3の分割をAudacityと言うアプリで行なうのに
　ラベルで分割と言う方法があります。

最終的には、下記のようなテキストファイルを作成してこれを利用して分割を行います。
（1行に　分割開始と分割終了時間を秒単位で指定して最後にラベル＝ファイル名を記載）

0.000000 336.000000 ABC
336.000000 635.000000 XDFF
635.000000 852.000000 KTYUG
852.000000 1106.000000 WER

上記のテキストファイルを作成に当たり、
　それぞれの時間の集計を求めるのにEXCEL関数を利用することにしました。
　集計が出た後は、VBAでテキストに書き込みたいのです。

B列にファイルの再生時間を記入
　　分秒ですが、集計を出すにあたり記入は時間分でインプットしています。
　　　　（5分36秒は5時間36分でインプット）
C列は配列数式で=sum($B$3:B3)*0.01666666666で以下コピペ
　表示形式は、[mm]:ss
D列は、単に分割開始時間を指定用の列で
　最初に0：00を記入して以後はC列を1行ずらして値のみコピペしています。
　表示形式は、h:mm:ss
E列は、D列の秒表示でD列こコピペして表示形式を[ss]に変更

|[A] |[B] |[C] |[D] |[E]
[1] | | |[mm]:ss |h:mm:ss|
[2] |ファイル名 |再生時間 |単純合計 |挿入用 |
[3] |ABC　　　　 |5:36 |05:36 |0:00 | 00
[4] |XDFF　　　　 |4:59 |10:35 |05:36 | 336
[5] |KTYUG　　　　 |3:37 |14:12 |10:35 | 635
[6] |WER　　　　　　 |4:14 |18:26 |14:12 | 852
[7] | 　 |3:18 |21:44 |18:26 |1106

--------------------------------
以上で一応必要な数値は見た目上は求められましたが
　これを、.000000を付加した形式で順番にVBAを利用して書き出す工程が残りました。

E列とA列を利用してタブで区切った形式で書き出す場合どうすれば良いでしょうか　？
具体的には、E列に.000000を付加した形式の処理方法が分かりません。

回答No.5

kkkkkm · ベストアンサー

> これは、仕様で普通の状態なのでしょうか　？

ブックをテキストファイルで書き出すとそのようになります。
それでNo2は元のマクロ有効ブック(実行前のブックの状態)で保存し直しています。

別のブックでテキスト書き出ししたほうがわかりやすいかもしれませんので、No3のコードをもとにしてください。

どちらにしても、マクロを実行する前にマクロ有効ブックとして開いているかどうか確認してください。

お礼

>ブックをテキストファイルで書き出すとそのようになります。

了解しました。

N03で改めてタブ形式でファイルを書き出した方が判りやすいですね。

今回も無事に解决しました。
　協力ありがとうございます。

回答No.4

kkkkkm

> Ws2.Cells(i - 2, "A").Value = .Cells(i, "F").Text & ".000000"
> Ws2.Cells(i - 2, "C").Value = .Cells(i + 1, "F").Text & ".000000"
> Ws2.Cells(i - 2, "D").Value = Trim(.Cells(i, "A").Value)

A列C列D列にデータを記載してますのでB列は何もない列として出来上がります。
もとはA列B列C列です。

別の回答にも書きましたが
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
は
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
にしてください。

あとは思惑通りに動けば問題ないと思います。

お礼

kkkkkmさん、アドバイスありがとうございます。

>C3は0にして
C>4に
>=SUM($B$3:B3)*0.01666666666
>でC7までコピーして表示形式を[ss]にしたら
>C列は現在のE列と同じになると思いますので

不必要な列を作成していたのですね。

上記のアドバイスを受けて頂いたコードを一部手直しして
　最終的なコードが以下になりました。
（コメント部分を非コメントにしてシート名が変更されない方を選択）
コメントあればお願いします。

質問の付随として教えて下さい。
　　一度、マクロでテキストファイルを書き出すと
　　　　コードを変更したブックを保存のため上書き保存を選択すると
　　　　ブックが上書き(修正)保存されないでテキストファイルが上書き保存されているようです。
　　　（上書き保存された後でブックを閉じて、再度開いてもコード修正がされていないので気が付きました。）

　名前を付けて保存を選択するとファイルの種類で
　　「Excel マクロ有効ブック」では無く「テキスト(タブ区切り)」でダイアログが開かれます。

　これは、仕様で普通の状態なのでしょうか　？
　　　　テキストファイルを書き出した後でも、「Excel マクロ有効ブック」で上書き保存するようにはできませんか　？

-------------------------------------------

Sub Make_Audacity_Label()

Dim i As Long
Dim FName As String
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim oldShName As String, oldFname As String
Dim LCN As Single

Set Ws1 = Sheets("Audacity") '元のシート
Set Ws2 = Sheets("Audacity_Label") 'データを書き出す為のシート
FName = "Audacity_Label" '出力するファイル名

Ws1.Activate

'A列の最終使用行番号
LCN = Ws1.Cells(Rows.Count, 1).End(xlUp).Row

oldShName = Ws2.Name
oldFname = ThisWorkbook.Name

With Ws1
.Range("D:D").NumberFormatLocal = "[ss]"
.Range("D3").NumberFormatLocal = "G/標準"
.Range("D3").Value = 0
.Range(.Cells(4, "D"), .Cells(LCN + 1, "D")).Formula = "=SUM($C$3:C3)"
Ws2.Range("A:C").NumberFormatLocal = "@"
For i = 3 To LCN
If Trim(.Cells(i, "A").Value) <> "" Then
Ws2.Cells(i - 2, "A").Value = .Cells(i, "D").Text & ".000000"
Ws2.Cells(i - 2, "C").Value = .Cells(i + 1, "D").Text & ".000000"
Ws2.Cells(i - 2, "D").Value = Trim(.Cells(i, "A").Value)
End If
Next
End With

'書き出しに不要なB列を削除して､セル幅を自動調整
Ws2.Columns("B").Delete
Ws2.Columns("A:C").AutoFit

Ws2.Activate
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & FName & ".txt", _
FileFormat:=xlText

'Sheet名やブック名が変わるのを元す
ActiveSheet.Name = oldShName
Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & oldFname, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
Application.DisplayAlerts = True

End Sub

回答No.3

kkkkkm

Sheet名やブック名を変更させなくて
テキストデータにしたいシートを新しいブックとして作成し、そちらからテキストファイルを作成する場合はこちらにしてください。

なお、前回までの回答のコードで
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
を
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row

に変更してください。Sheet1以外を表示している場合にSheet2にデータを転記できていませんでした

Sub Test2()
Dim i As Long
Dim FName As String
Dim Ws1 As Worksheet, Ws2 As Worksheet

Set Ws1 = Sheets("Sheet1") '元のシート
Set Ws2 = Sheets("Sheet2") 'データを書き出す為のシート
FName = "TxtTest" '出力するファイル名
With Ws1
.Range("C:C").NumberFormatLocal = "[ss]"
.Range("C3").NumberFormatLocal = "G/標準"
.Range("C3").Value = 0
.Range(.Cells(4, "C"), .Cells(.Cells(Rows.Count, "B").End(xlUp).Row, "C")).Formula = "=SUM($B$3:B3)*0.01666666666"
Ws2.Range("A:B").NumberFormatLocal = "@"
For i = 3 To .Cells(Rows.Count, "A").End(xlUp).Row
If Trim(.Cells(i, "A").Value) <> "" Then
Ws2.Cells(i - 2, "A").Value = .Cells(i, "C").Text & ".000000"
Ws2.Cells(i - 2, "B").Value = .Cells(i + 1, "C").Text & ".000000"
Ws2.Cells(i - 2, "C").Value = Trim(.Cells(i, "A").Value)
End If
Next
End With
Ws2.Copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & FName & ".txt", _
FileFormat:=xlText
End Sub

回答No.2

kkkkkm

C3は0にして
C4に
=SUM($B$3:B3)*0.01666666666
でC7までコピーして表示形式を[ss]にしたら
C列は現在のE列と同じになると思いますので
データとしてA列B列を入力して

C列の計算式からVBAでやってしまいA列C列を操作対象とした場合

(Sheet名やブック名が変わるのを元に戻したい場合はコメント部分を非コメントにしてください)

Sub Test()
Dim i As Long
Dim FName As String
Dim Ws1 As Worksheet, Ws2 As Worksheet

'Dim oldShName As String, oldFname As String

Set Ws1 = Sheets("Sheet1") '元のシート
Set Ws2 = Sheets("Sheet2") 'データを書き出す為のシート
FName = "TxtTest" '出力するファイル名

'oldShName = Ws2.Name
'oldFname = ThisWorkbook.Name

With Ws1
.Range("C:C").NumberFormatLocal = "[ss]"
.Range("C3").NumberFormatLocal = "G/標準"
.Range("C3").Value = 0
.Range(.Cells(4, "C"), .Cells(.Cells(Rows.Count, "B").End(xlUp).Row, "C")).Formula = "=SUM($B$3:B3)*0.01666666666"
Ws2.Range("A:B").NumberFormatLocal = "@"
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If Trim(.Cells(i, "A").Value) <> "" Then
Ws2.Cells(i - 2, "A").Value = .Cells(i, "C").Text & ".000000"
Ws2.Cells(i - 2, "B").Value = .Cells(i + 1, "C").Text & ".000000"
Ws2.Cells(i - 2, "C").Value = Trim(.Cells(i, "A").Value)
End If
Next
End With
Ws2.Activate
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & FName & ".txt", _
FileFormat:=xlText

'ActiveSheet.Name = oldShName
'Application.DisplayAlerts = False
'ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & oldFname, _
' FileFormat:=xlOpenXMLWorkbookMacroEnabled
'Application.DisplayAlerts = True

End Sub

お礼

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

今回頂いたコードを検証する前に
　現状を解决したいので手直しすべき点あればご指導下さい。
----------------

その後、時間入力を簡単に入力できるように表の構成を一部変更しました。
　C列の計算式は、以下です。
　　　=IF(B3="","",TEXT(B３,"0!:00!:00")*1)

又、
私のVBAの理解度が低いので融通が効かず、
　以前頂いたコードを参考に今まで手動でコピペしていたのを
　自動でできるようにE,F列をVBAにコードを追加しました。

一応、テキストファイルは、作成できました。
　但し、テキストに簡単入力を追加したので書き出されたテキストに不必要なタブができてしまったので
　その列（B列）を最後に削除するコードをごまかしで追加しています。

以下が現在のシート1の構成です。
|[A] |[B] |[C] |[D] |[E] |[F]
[1] | | | |h:mm:ss | |
[2] |MP3 |簡単入力 |再生時間 |単純合計 | |
[3] |bbb | 553|0:05:53 |0:05:53 |0:00:00| 00
[4] |dfdf| 516|0:05:16 |0:11:09 |0:05:53| 353
[5] |kjhj| 432|0:04:32 |0:15:41 |0:11:09| 669
[6] |ujhj| 547|0:05:47 |0:21:28 |0:15:41| 941
[7] |dfgh| 505|0:05:05 |0:26:33 |0:21:28|1288
[8] |rtyu| 330|0:03:30 |0:30:03 |0:26:33|1593
[9] |rtyh| 1841|0:18:41 |0:48:44 |0:30:03|1803
[10]|fgbv| 530|0:05:30 |0:54:14 |0:48:44|2924
[11]|dcfv| 618|0:06:18 |1:00:32 |0:54:14|3254
[12]|dddf| 1620|0:16:20 |1:16:52 |1:00:32|3632
[13]|edfv| 1005|0:10:05 |1:26:57 |1:16:52|4612
[14]|dfvg| 103|0:01:03 |1:28:00 |1:26:57|5217
[15]| | | | |1:28:00|5280

以下が、現在のコードです。

Sub Make_Audacity_Label()
Dim i As Long
Dim FName As String
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LCN As Single

Set Ws1 = Sheets("Audacity") '元のシート
Set Ws2 = Sheets("Audacity_Label") 'データを書き出す為のシート
FName = "Audacity_Label" '出力するファイル名

'A列の最終使用行番号
LCN = Cells(Rows.Count, 1).End(xlUp).Row

'単純合計(D列）をE列に値のみ１行ずらしてコピペ
Ws1.Range(Cells(3, 4), Cells(LCN, 4)).Copy
Ws1.Cells(4, 5).PasteSpecial Paste:=xlPasteValues

'E列をF列に値のみコピペしてセル書式を[ss]に指定
Ws1.Range(Cells(3, 5), Cells(LCN + 1, 5)).Copy
Ws1.Cells(3, 6).PasteSpecial Paste:=xlPasteValues
Ws1.Range("F:F").NumberFormatLocal = "[ss]"

With Ws1
Ws2.Range("A:C").NumberFormatLocal = "@"
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If Trim(.Cells(i, "A").Value) <> "" Then
Ws2.Cells(i - 2, "A").Value = .Cells(i, "F").Text & ".000000"
Ws2.Cells(i - 2, "C").Value = .Cells(i + 1, "F").Text & ".000000"
Ws2.Cells(i - 2, "D").Value = Trim(.Cells(i, "A").Value)
End If
Next
End With

書き出しに不要なB列を削除して､セル幅を自動調整
Ws2.Columns("B").Delete
Ws2.Columns("A:C").AutoFit

'ラベルの書き出し
Ws2.Activate
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & FName & ".txt", _
FileFormat:=xlText
End Sub

回答No.1

kkkkkm

> D列は、単に分割開始時間を指定用の列で
>　最初に0：00を記入して以後はC列を1行ずらして値のみコピペしています。

このあたりがよくわからなかったのですが
E列が質問のような表示になっているとしたら、以下の方法で試してみてください。

Sub Test()
Dim i As Long
Dim FName As String
Dim Ws1 As Worksheet, Ws2 As Worksheet

Set Ws1 = Sheets("Sheet1") '元のシート
Set Ws2 = Sheets("Sheet2") 'データを書き出す為のシート
FName = "TxtTest" '出力するファイル名

With Ws1
Ws2.Range("A:B").NumberFormatLocal = "@"
For i = 3 To Cells(Rows.Count, "A").End(xlUp).Row
If Trim(.Cells(i, "A").Value) <> "" Then
Ws2.Cells(i - 2, "A").Value = .Cells(i, "E").Text & ".000000"
Ws2.Cells(i - 2, "B").Value = .Cells(i + 1, "E").Text & ".000000"
Ws2.Cells(i - 2, "C").Value = Trim(.Cells(i, "A").Value)
End If
Next
End With
Ws2.Activate
ThisWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & FName & ".txt", _
FileFormat:=xlText
End Sub

お礼

kkkkkmさん、アドバイスありがとうございます。

提示いただいたコードで完璧にテキストファイルが作成されました。

>　最初に0：00を記入して以後はC列を1行ずらして値のみコピペしています。

この点ですが、
　EXCELが堪能な方には実はD列、E列は無駄な列と言えます。

　　D3は、単に最初の分割開始時間（0：00：00）明確にするだけに記載しただけで
　　　いつも0から始まるので必要はありません。
　　又、
　　　D列を作るためにわざわざD3以下にC列のデータをコピペする本来は必要のない作業です。

そこでC列までセルに計算したら
　D列、E列を作成せずに後はVBA側で同じ処理ができないでしょうか　？