- ベストアンサー
（VBA)FORMATを変換して書き出したい
kkkkkmの回答
Excel ワークシートのセルに VBA の日付形式またはバリアント型の日付形式を割り当てようとすると、ミリ秒が最も近い秒に丸められます。 https://support.microsoft.com/ja-jp/topic/excel-%E3%83%AF%E3%83%BC%E3%82%AF%E3%82%B7%E3%83%BC%E3%83%88%E3%81%AE%E3%82%BB%E3%83%AB%E3%81%AB-vba-%E3%81%AE%E6%97%A5%E4%BB%98%E5%BD%A2%E5%BC%8F%E3%81%BE%E3%81%9F%E3%81%AF%E3%83%90%E3%83%AA%E3%82%A2%E3%83%B3%E3%83%88%E5%9E%8B%E3%81%AE%E6%97%A5%E4%BB%98%E5%BD%A2%E5%BC%8F%E3%82%92%E5%89%B2%E3%82%8A%E5%BD%93%E3%81%A6%E3%82%88%E3%81%86%E3%81%A8%E3%81%99%E3%82%8B%E3%81%A8-%E3%83%9F%E3%83%AA%E7%A7%92%E3%81%8C%E6%9C%80%E3%82%82%E8%BF%91%E3%81%84%E7%A7%92%E3%81%AB%E4%B8%B8%E3%82%81%E3%82%89%E3%82%8C%E3%81%BE%E3%81%99-4a0af2c5-78de-762f-6431-8669890f585b これにしたらいけそうです。 ws2.Cells(i, "B").Value2 = DateAdd("s", Dtime, ws2.Cells(i, "A").Value2) '開始時間に10秒を加算 Dim Dtime As String は Dim Dtime As Long じゃないでしょうか
関連する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