- ベストアンサー
（VBA)FORMATを変換して書き出したい
以下のようなテキストファイルを CHAPTER01=0:00:00.000 CHAPTER01NAME=test_001 CHAPTER02=0:04:02.719 CHAPTER02NAME=test_456 CHAPTER03=0:08:33.859 CHAPTER03NAME=test_741 下記のようなフォーマットにEXCELのVBAを利用して変更してテキストファイルで書き出したい 最初のモデルになるようなマクロコードを教えてください。 1 00:00:00,000 --> 00:00:10.000 test_001 2 00:04:02,719 --> 00:04:12.719 test_456 3 00:08:33,859 --> 00:08:43.859 test_456 このように、番号、開始時間と終了時間、テキストの3つの要素があります。 時間は時:分:秒,ミリ秒の形式で表されます。 各要素は空白行で区切られます。 終了時間=開始時間+10秒(00:00:10.000) ’---------------------------- 一応、何とか自前でコードは完成しましたが 運用上は問題なのですが算数的にはおこしな事になっています。 以下でDtime（10秒）を加算していますが ws2.Cells(i, "B") = DateAdd("s", Dtime, ws2.Cells(i, "A")) ws2.Cells(i, "A") が 0:04:02.719 だとすると 0:04:12.719 になるはずが 実際は、ws2.Cells(i, "B") は 0:04:13.000 と小数点以下がゼロになっています。 訂正を及びコードに関してアドバイスあればお願いします。 Option Explicit Sub test() Dim ws1 As Worksheet, ws2 As Worksheet Dim ls As Long, i As Long Set ws1 = Worksheets("DATA") Set ws2 = Worksheets("Convert") ls = ws1.Cells(Rows.Count, "A").End(xlUp).Row Dim txt As String Dim Dtime As String ws2.Cells.Clear ws2.Columns("A").NumberFormatLocal = "h:mm:ss.000" ws2.Columns("B").NumberFormatLocal = "h:mm:ss.000" For i = 1 To ls Step 2 '開始時間 txt = ws1.Cells(i, "A").Value ws2.Cells(i, "A") = Mid(txt, InStr(txt, "=") + 1) '表示時間指定 （任意） Dtime = 10 '終了時間 ws2.Cells(i, "B") = DateAdd("s", Dtime, ws2.Cells(i, "A")) '開始時間に10秒を加算 '時間部（開始 --> 終了) ws2.Cells(i, "C") = ws2.Cells(i, "A").Text & " --> " & ws2.Cells(i, "B").Text 'Title txt = ws1.Cells(i + 1, "A").Value ws2.Cells(i + 1, "C") = Mid(txt, InStr(txt, "=") + 1) Next 'Plane Text 保存 ----------------- Dim R_data As Integer '行番号 R_data = 1 Open "C:\Users\ABC\Desktop\Plane_text.txt" For Output As #1 Do While ws2.Cells(R_data, "C") <> "" Print #1, ws2.Cells(R_data, "C") If R_data Mod 2 = 0 Then '2の倍数のとき Print #1, "" '空白行を出力 End If R_data = R_data + 1 Loop Close #1 End Sub ’---------------------------------
- NuboChan
- お礼率65% (1303/1985)
- Excel（エクセル）
- 回答数5
- ありがとう数5
- みんなの回答 （5）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (4)
- kkkkkm
- ベストアンサー率65% (1624/2466)
> Byte（0-255）でも十分なのですがInteger(-32768-32767) に変更しました。 これですが、最近はLongの方が効率がいいみたいで 最近のバージョンではInteger型を指定しても自動的にLong型に変換されるらしいです。 VBAの整数型Integerがわかる！Long型・Byte型との違いも解説 https://www.tech-teacher.jp/blog/vba-integer/ 【ExcelVBA】Integer型とLong型の使い分けは？処理速度が速いのは？ https://moripro.net/vba-integer-long/
お礼
ありがとうございます。 アドバイスで以下、理解できました。 「最近のバージョンではInteger型を指定しても自動的にLong型に変換されるようになっています。」 「ソースコードが長い場合には、Integer型をLong型に変換する手間のために処理が遅くなる可能性もあります。 実際のコードで整数型の変数を使用するときには、処理を高速化するため、Long型を指定するようにしましょう。」 メモリーの消費を昔よりも気にしなくても良くなった昨今では、Longで統一する事にします。 ＞こちらもShft-JISなのですが何故なんでしょうね・・・。 不思議ですが、気にしないで忘れる事にします。 サンプルで上手く処理出来たので実際のケースで試用を初めてみます。 今回もお世話になりありがとうございました。 （実ケースで不具合が出た場合は、改めて相談させていただきたいと思います。）
- kkkkkm
- ベストアンサー率65% (1624/2466)
- kkkkkm
- ベストアンサー率65% (1624/2466)
> 「ファイルにこれ以上データがありません 」のエラーが出ます。 そうですか何故なのでしょうね。単に一気に読み込むだけだと思いましたが忘れましょう。 > コードを確認していただけるならこちらのコードでお願いします。 なにか問題があるでしょうか。問題が無ければ変なところがあるとは思われないです。
お礼
的確なアドバイスありがとうございます。 以下のように.value2を追加して小数点以下も拾えるようになりました。 ws2.Cells(i, "B").Value2 = DateAdd("s", Dtime, ws2.Cells(i, "A")) ＞Dim Dtime As Long Stringではおかしいです。 （それなのにエラーはでませんでした。不思議です。） マイナスを設定する事は無いので Byte（0-255）でも十分なのですがInteger(-32768-32767) に変更しました。 ＞そうですか何故なのでしょうね。 ＞単に一気に読み込むだけだと思いましたが忘れましょう。 不思議なのは、エラーでると読み込むファイルが破損するのか？ 中身が空のファイルになっています。 調べたら元のファイルがShift＿Jisの場合は破損するので UTF＿8に変換したら上手く処理できました。 但し、以下のように9の次が1になりました。 9 00:43:18.447 12356 1 00:50:51.857 78956
- kkkkkm
- ベストアンサー率65% (1624/2466)
関連するQ&A
- (VBA)Splitの抜き出しが上手くいかない
以下のようなコードで「指定区切り文字」の前後で文字列を切り出しています。 添付画像見てもらえれば判ると思いますが B8セルからのB列の値が「29:08」が正解なのに 「29:08:00」と最後に「:00」が付いた形式になっています。 （B13で1時間を過ぎると正常になっています。） このため、以後のE及びF列の書き出しもおかしな値となりました。 どのように修正すれば良いでしょうか ？ Option Explicit Sub Chapter_Plus() Dim I As Long Dim J As Long Dim TEMP As Variant Dim SepChr As String Dim WS1 As Worksheet Dim WS2 As Worksheet Dim EndLow As Long Dim LineData As String Dim OutText As String Dim byteData() As Byte '一時格納用 Set WS1 = Worksheets("DATA") Set WS2 = Worksheets("Chapter") 'シートの初期化 WS1.Range("B3:H100").Clear WS2.Range("A1:A100").Clear SepChr = InputBox("指定文字を入力してください。", "区切り文字入力", " ") 'TotalLength = InputBox("時間を(h:mm:ss)で入力してください。", "ファイルサイズ入力") EndLow = WS1.Cells(Rows.Count, "A").End(xlUp).Row With WS1 '区切り文字で切り出す For I = 3 To EndLow TEMP = Split(.Cells(I, "A"), SepChr) .Cells(I, "B") = TEMP(0) .Cells(I, "C") = TEMP(1) Next '仮チャプター書き出す For I = 3 To EndLow .Cells(I, "E").Value = Format(.Cells(I, "B").Value, "hh:mm:ss") .Cells(I, "F").Value = Format(.Cells(I + 1, "B").Value, "hh:mm:ss") .Cells(I, "G").Value = .Cells(I, "C").Value Next '番号 For I = 3 To EndLow .Cells(I, "H").Value = CStr(Format(I - 2, "'00")) Next End With End SUB
- ベストアンサー
- Excel（エクセル）
- EXCEL2010エラーVBA
下記を実行するとエラーになりEXCEL2010が終了してしまいます。 fDebug:0 offset00009391 がエラーメッセージです。 何が原因でしょうか。 Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet Dim rg As Range Dim r As Variant Dim c As Long Dim hanni1 As Range Dim atai As Range Set ws = Worksheets("あああ") Set rg = Worksheets("コード").Range("A1:B10") r = ws.Cells(Rows.Count, 1).End(xlUp).Row Set hanni1 = ws.Range(Cells(2, 2), Cells(r, 3)) Set atai = ws.Range(Cells(2, 3), Cells(r, 3)) atai = Application.VLookup(hanni1, rg, 2, False) End Sub
- ベストアンサー
- その他（プログラミング・開発）
- EXCELVBAでデータをテキストファイルで出力したいと
EXCELVBAでデータをテキストファイルで出力したいと考えています。 ***************************** 作成したVBA ***************************** Sub test_Click() Dim fNAME As String fNAME = "c:\test.txt" Open fNAME For Output As #1 i = 1 Print #1, "<test=" & Cells(1, i) & "," & Cells(2, i) & "," & Cells(3, i) & "," & Cells(4, i) & "," & Cells(5, i) & ">" Close #1 '閉じる End Sub ***************************** エクセルの値 ***************************** Ａ列 １ ２ ３ ４ ５ ***************************** 出力されたテキストファイル ***************************** <test=１,２,３,４,５> このようになっていますが、 エクセルが Ａ列 １ ２ のように、２個しかないと、 <test=１,２,,,> のようになってしまいます。 <test=１,２> ↑のようになるように、エクセルの値に応じて、 「,」が出力しないようにしたいです。 どうしたらよいのでしょうか。 よろしくおねがいします。
- 締切済み
- その他（プログラミング・開発）
- ＶＢＡで検索してコピー
エクセル2003を使っています。 下記のような構文で、あるデータを検索しています。 検索まではできましたが、その検索したデータが入力されている行を選択して別のシートにコピーしたいです。 Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet Dim rng As Range Set ws1 = Sheets("CSV") '検索先のシート Set ws2 = Sheets("0群加工") '検索データのシート Set ws3 = Sheets("完了") '貼付先シート Set ws4 = Sheets("過程") With ws1.Columns("A") '完全一致でシートの頭から検索（A列） i = 2 Do Until ws2.Cells(i, "E").Value = "" 'ws2のデータがなくなるまで Set rng = .Find(What:=ws2.Cells(i, "E").Value, LookAt:=xlPart, After:=.Cells(.Cells.Count)) '検索 上記は0群加工シートに入力されているデータを、CSVシートに入力されているデータを検索しています。 （ここのデータというのは時間が入力されています。つまり、0群シートに入力されている時間と同じ時間を、CSVシートで検索しています） CSVシートに同じデータがあれば、そのデータがあるセルが属する行をコピーして、違うシートに貼り付けたいです。 よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- エクセル2019 VBAについて
エクセル2019でVBAを使いコピーペーストの勉強中です、次の箇所(Dim i As integr)で、ユーザー定義型は定義されていませんと指摘されて止まってしまします、Sheet("データ")には3行のデータは入っています、VBA初心者のため、この後が、なかなか前に進めません、どうかよろしくおねがいします。 ********************************** Sub 練習() Dim s1 As Worksheet: Set s1 = Worksheets("請求書") Dim s2 As Worksheet: Set s2 = Worksheets("データ") Dim r1 As Integer: r1 = 18 Dim r2 As Integer: r2 = 2 { Dim i As integr } For i = 0 To 2 s1.Range(s1.Cells(r1 + i, 1), s1.Cells(r1 + i, 3)).Value = s2.Range(s2.Cells(r2 + i, 2), s2.Cells(r2 + i, 4)).Value s1.Cells(r1 + i, 4).Value = s1.sells(r1 + i, 2).Value * s1.Cells(r1 + i, 3).Value Next End Sub ***************************************
- ベストアンサー
- Excel（エクセル）
- [VBA] For文の使い分けについての疑問
こちらの識者の方々にはいつもお世話になっています。 VBAの質問です。 環境は下記になります。 OS=windows7 pro 64bit Office=Excel2010(14.0.7128.5000) ・疑問点 For each nextもFor nextも、最下行まで処理をしたいときに使用することが多いのですが、 単列の場合はFor each next、複数列の場合はFor nextというような使い方をしています。 例：For each next Sub test() Dim ws As Worksheet Dim r As Range Dim endRow As Long Set ws = ThisWorkbook.Sheets(1) endRow = ws.Cells(Rows.Count, 1).End(xlUp).Row For Each r In ws.Range("A1:A" & endRow) If r.Value Mod 2 = 0 Then r.Font.Bold = True Next r End Sub 例：For next Sub test2() Dim ws As Worksheet Dim i As Long Dim endRow As Long Set ws = ThisWorkbook.Sheets(1) endRow = ws.Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To endRow If ws.Cells(i, 1).Value Mod 2 = 0 Then ws.Cells(i, 1).Font.Bold = True If ws.Cells(i, 2).Value Mod 3 = 0 Then ws.Cells(i, 2).Font.Bold = True Next i End Sub 単純に、複数列での処理をする場合にはFor each next文を2つ書かないといけないと思い（込み）、 上記のような運用にしていますが、そもそもこの考え方は合っていますでしょうか？ 単列の処理であってももちろんFor next文で問題なく使用できますし、 複数列の処理の場合もFor each next文で処理することはできます（冗長ですが）が、 VBA的に正しいというか、合理的な考えであるのかどうかが疑問です。 みなさんはFor each nextとFor nextをどのように使い分けていますか？ 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。
- ベストアンサー
- Excel（エクセル）
- エクセルで在庫表を作ろうとしています
エクセルで在庫表を作ろうとしているのですが、躓いてしまって困っています。 TEST1 コードを手入力した後実行 TEST2 出庫数を入力した後実行 Option Explicit Option Base 1 Sub TEST1() 'コードを手入力した後実行 Dim ws1 As Worksheet Dim ws2 As Worksheet Dim r&, i& Dim vL1 As String Dim vL2 As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") r = ws1.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To r vL1 = Application.WorksheetFunction.VLookup(ws1.Cells(i, 1), ws2.Range("A2:IV65536"), 2, False) ws1.Cells(i, 1).Offset(, 1) = vL1 vL2 = Application.WorksheetFunction.VLookup(ws1.Cells(i, 1), ws2.Range("A2:IV65536"), 3, False) ws1.Cells(i, 1).Offset(, 2) = vL2 Next i End Sub Sub TEST2() '出庫数を入力した後実行 Dim ws1 As Worksheet Dim ws2 As Worksheet Dim r&, i& Dim vL2 As Long Dim vL3 As String Dim syukko As Long Dim fnd As Range Dim zaiko As Long Set ws1 = Worksheets("Sheet1") Set ws2 = Worksheets("Sheet2") r = ws1.Cells(Rows.Count, 1).End(xlUp).Row For i = 2 To r If ws1.Cells(i, 4) > 0 Then syukko = ws1.Cells(4, 1).Offset(, 3).Value vL2 = Application.WorksheetFunction.VLookup(ws1.Cells(3, 2), ws2.Range("A2:IV65536"), 3, False) Set fnd = ws2.Range("A:A").Find(ws1.Cells(i, 1)) If fnd Is Nothing = False Then zaiko = vL2 - syukko fnd.Offset(, 2) = zaiko End If MsgBox ws1.Cells(i, 2) & "を" & syukko & "出庫します" & vbLf & "在庫は" & zaiko & "になります。" Else MsgBox "出庫数を入力して下さい" Exit Sub End If Next i ws1.Range("A2:D65536").ClearContents End Sub ここまでは作りました。 ですが、プロシージャの外では無効です と出てしまいます。 どうすればよいのでしょうか。 教えて下さい。 シート1のＢ2にコード・C3に名前・D2に現在個数・E2に出庫数を入力します。 実際にはB3からすうじを入力し、コードを入力すれば自然に名前と現在個数を シート2から探してくるようにしたいです。 シート2にはA列にコード、B列に名前、C列に現在庫数が載っている表があります(量が半端ではないです) 出来れば、1度出庫数を入れたら、次開いた時にシート2のC列にある現在個数が自然に減っていて、シート1にはフォームしか残らない状態にしたいです。 お願いします<m(__)m>
- 締切済み
- オフィス系ソフト
- 「'」もascで変換させたい
Ａ１に「'test」と入れると「test」になってしまいます。 そして、 Sub test() Dim MojiInt As Long Dim i As Long Dim myRow As Long Dim Moji As String MojiInt = Len(Cells(1, 1)) For i = 1 To MojiInt Moji = Mid((Cells(1, 1)), i, 1) If i = 1 Then Cells(1, 2) = Asc(Moji) Else Cells(1, 2) = Cells(1, 2) & "," & Asc(Moji) End If Next i End Sub をすると、 116,101,115,116 になります。 最初の「'」もascで変換させることは無理なのでしょうか？
- ベストアンサー
- その他MS Office製品
- VBA sheet2データーから平均取得 sheet1へコピー
sheet2指定セルデーターから平均 sheet1指定セルに取得したいのですがうまくいきません。 例 sheet1 sheet2 列A 列B 列C 列A 列B 列C １ ２ 指定 １ ２ ３ １ ２ ３ １ ２ ３ １ ２ ３ １ ２ ３ sheet2・列C１～３の平均を、sheet1・指定セルに取得したいのですが Sub test() Dim r As Long, u As Long, ws1 As Object, ws2 As Object, y As Long r = 10 u = 1 Set ws1 = Sheets(1) Set ws2 = Sheets(2) y = ws1.Range("A" & Rows.Count).End(xlUp).Row Dim myAve As Long myAve = Application.WorksheetFunction.Average(ws2.Range(Cells(3, u), Cells(7, u))) ws1.Cells(r, 7).Value = "myAve" r = r + 1 u = u + 1 End Sub 変数y r u を使いfor～nextでデーターを一括取得するつもりなのですが この段階でうまくいきません。
- ベストアンサー
- Visual Basic
- (VBA) FOR文の修正をお願いします。
基本的な事でうまく処理できません。 下記コードで シート（DATA)の内容を シート（Chapter）に順番(FOR文）に書き出したいのですが コードの修正をお願いします。 添付画像で説明すると ①の内容を ②のように書き換えたいのですが 実際の現在のコードでは③のようになってしまいます。 FOR文の変数（I）とSTEPの値が間違っているのですが 基本的なことですいません。 ------------------------------------------------------------- Set WS1 = Worksheets("DATA") With Worksheets("Chapter") For I = 1 To EndLow - 2 Step 2 .Cells(I, "A") = "CHAPTER" & WS1.Cells(I + 2, "H") & "=" & Format(WS1.Cells(I + 2, "E").Value, "h:mm:ss") .Cells(I + 1, "A") = "CHAPTERNAME=" & WS1.Cells(I + 2, "G") Next End With
- ベストアンサー
- Excel（エクセル）
お礼
毎度、kkkkkmさんからのアドバイスありがとうございます。 早速、いただいたコードを起動させてみましたが mTxt = mInTxtFile.ReadAll で 「ファイルにこれ以上データがありません 」のエラーが出ます。 私のコードもその後色々と不具合が見つかったので 現在は、以下のように修正しています。 先に、どうすべきか提案させて点を除けば何とか利用できるまでは来ていると思います。 （コードを確認していただけるならこちらのコードでお願いします。） Option Explicit Sub Test_2() Dim ws1 As Worksheet, ws2 As Worksheet Dim ls As Long, i As Long Set ws1 = Worksheets("DATA") Set ws2 = Worksheets("Convert") ls = ws1.Cells(Rows.Count, "A").End(xlUp).Row Dim txt As String Dim Dtime As Integer ws2.Cells.Clear ws2.Columns("A").NumberFormatLocal = "h:mm:ss.000" ws2.Columns("B").NumberFormatLocal = "h:mm:ss.000" Dim temp As String For i = 1 To ls Step 2 '開始時間 txt = ws1.Cells(i, "A").Value ws2.Cells(i, "A") = Mid(txt, InStr(txt, "=") + 1) '表示時間(秒)指定 （任意） Dtime = 10 '終了時間 ws2.Cells(i, "B") = DateAdd("s", Dtime, ws2.Cells(i, "A")) '開始時間に秒を加算 '時間部（開始 --> 終了) フォーマット一部変更 temp = ws2.Cells(i, "A").Text & " --> " & ws2.Cells(i, "B").Text ws2.Cells(i, "C") = Replace(temp, ".", ",") 'Title txt = ws1.Cells(i + 1, "A").Value ws2.Cells(i + 1, "C") = Mid(txt, InStr(txt, "=") + 1) Next 'Plane Text 保存 ----------------- Dim R_data As Integer '行番号 R_data = 1 Open "C:\Users\AAA\Desktop\Plane_text.srt" For Output As #1 Dim j As Integer j = 1 For i = 1 To ls Step 2 Print #1, CStr(j) 'jの値を文字列に変換して半角の空白が出力されるないようにする Print #1, ws2.Cells(i, "C") Print #1, ws2.Cells(i, "C").Offset(1, 0) Print #1, "" '区分用の空白行を追加して出力 j = j + 1 Next Close #1 End Sub