(VBA) FOR文の修正をお願いします。

このQ&Aのポイント
  • シート(DATA)の内容をシート(Chapter)に順番(FOR文)に書き出したい。
  • 現在のコードではFOR文の変数とSTEPの値が間違っている。
  • 修正したいコードはそのままではなく、特定の形式に書き換える必要がある。
回答を見る
  • ベストアンサー

(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

質問者が選んだベストアンサー

  • ベストアンサー
  • watabe007
  • ベストアンサー率62% (476/760)
回答No.1

参考に Dim WS As Worksheet, EndLow As Long Dim I As Long, J As Long Set WS1 = Worksheets("DATA") EndLow = WS1.Cells(Rows.Count, "E").End(xlUp).Row With Worksheets("Chapter") For I = 3 To EndLow J = J + 1 .Cells(J, "A") = "CHAPTER" & WS1.Cells(I, "H") & "=" & Format(WS1.Cells(I, "E").Value, "h:mm:ss") J = J + 1 .Cells(J, "A") = "CHAPTERNAME=" & WS1.Cells(I, "G") Next End With

NuboChan
質問者

お礼

watanabe007さん、回答ありがとうございます。 変数(J)の使い方は、全く考えが及びませんでした。 No.2の回答も参考になりました。 おかげさまで無事解決しました。

その他の回答 (2)

  • kkkkkm
  • ベストアンサー率65% (1617/2456)
回答No.3

With Worksheets("Chapter") For I = 1 To EndLow - 2 .Cells(I + .Rows(I).Row - 1, "A") = "CHAPTER" & WS1.Cells(I + 2, "H") & "=" & Format(WS1.Cells(I + 2, "E").Value, "h:mm:ss") .Cells(I + .Rows(I).Row, "A") = "CHAPTERNAME=" & WS1.Cells(I + 2, "G") Next End With でいけると思いますが、変に計算するより 単純に J = 1 With Worksheets("Chapter") For I = 1 To EndLow - 2 .Cells(J, "A") = "CHAPTER" & WS1.Cells(I + 2, "H") & "=" & Format(WS1.Cells(I + 2, "E").Value, "h:mm:ss") .Cells(J + 1, "A") = "CHAPTERNAME=" & WS1.Cells(I + 2, "G") J = J + 2 Next End With とした方が、変更になったときに対処しやすいと思います。

  • watabe007
  • ベストアンサー率62% (476/760)
回答No.2

こちらも For I = 3 To EndLow .Cells((I - 3) * 2 + 1, "A") = "CHAPTER" & WS1.Cells(I, "H") & "=" & Format(WS1.Cells(I, "E").Value, "h:mm:ss") .Cells((I - 3) * 2 + 2, "A") = "CHAPTERNAME=" & WS1.Cells(I, "G") Next

関連するQ&A

  • エクセルVBAでFor each文

    下記のようなコードを書きたいのですが「オブジェクトが必要です」というエラーが 出力されてしまいできないようです。何か代替案はありますでしょうか。 --- dim ws as worksheet with thisworkbook for each ws in array(.worksheets(1),.worksheets(2),.worksheets(3)) with ws 'ここに処理を書く end with next ws end with --- ちなみにこのbookにある全てワークシートで処理を回したいわけではなく 特定のシートのみで処理をしたいです。 エクセル2003です。 よろしくお願いします。

  • (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

  • (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 ’---------------------------------

  • 横にコピーするには・・。

    教えてください・・。 01.xls・02.xls・03.xlsとあり、その中のシート(01・02・03)をコピーして、全部というシートにまとめたいと思っています。 列にデータを追加したいのですが、行にデータが追加されてしまいます・・。 どうしたらいいのか教えてください。 01のシートがAからDまで 02のシートがEからGまで 03のシートがHからLまで とコピーをしたいと思っています・・。 --------- PathName = ThisWorkbook.Path & "\" ArrBook = Array("01.xls", "02.xls", "03.xls") For i = LBound(ArrBook) To UBound(ArrBook) Workbooks.Open PathName & ArrBook(i) Next Set WS(1) = Workbooks("01.xls").Worksheets("01") Set WS(2) = Workbooks("02.xls").Worksheets("02") Set WS(3) = Workbooks("03.xls").Worksheets("03") Set WS(4) = ThisWorkbook.Worksheets("全部") With WS(4) .Cells.ClearContents .Cells(1, 1) = "A" .Cells(1, 2) = "B" .Cells(1, 3) = "C" .Cells(1, 4) = "D" .Cells(1, 5) = "E" .Cells(1, 6) = "F" .Cells(1, 7) = "G" .Cells(1, 8) = "H" .Cells(1, 9) = "I" .Cells(1, 10) = "J" .Cells(1, 11) = "K" .Cells(1, 12) = "L" .Cells(1, 13) = "M" .Cells(1, 14) = "N" .Cells(1, 15) = "O" .Cells(1, 16) = "P" .Cells(1, 17) = "Q" LastRow(1) = WS(1).Range("A65536").End(xlUp).Row LastRow(2) = WS(2).Range("A65536").End(xlUp).Row LastRow(3) = WS(3).Range("A65536").End(xlUp).Row For i = 1 To 3 LastRow(4) = .Range("A65536").End(xlUp).Row + 1 WS(i).Rows("2:" & LastRow(i)).Copy .Cells(LastRow(4), 1) LastRow(4) = .Range("A65536").End(xlUp).Row End With For i = LBound(ArrBook) To UBound(ArrBook) Workbooks(ArrBook(i)).Close SaveChanges:=False Next End Sub

  • [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をどのように使い分けていますか? 質問に不備不足等ございましたらご指摘ください。 ご面倒お掛けしますがよろしくお願いします。

  • VBAでの説明がわかりません

    以下のコードは、都道府県ごとに1枚のデータシートを作成する処理なんですが、コードが1行づつどんな作業を意味しているのかがわかりません。1行ごとにどのような処理をしているのかの説明をよろしくお願いします。長文で申し訳ありません。 Sub まとめ() Dim i As Integer 'カウンタ変数iの宣言 Dim n As Integer  Dim MyS1 As Worksheet 'ワークシート型オブジェクトMyS1を宣言 Dim MyC As Worksheet Worksheets.Add before:=Worksheets("全国") ActiveSheet.Name = "data" Set MyS1= Worksheets("data") With Worksheets("全国") MyS1. Range(MyS1.Cells(1,1),MyS1.Cells(11,12))=.Range(Cells(1,1),.Cells(11,12)).Value End With i=12 For Each MyC In Worksheets If MyC.Name<> "data" Then n = 12 MyS1.Cells(i,1)=MyC.Name i=i+1 Do While MyC.Cells(n,2).Value<>"" MyS1.Range(MyS1.Cells(i,1),MyS1.Cells(i,12))=MyC.Range(MyC.Cells(n,1),Mc.Cells(n,12)).Value i=i+1 n=n+1 Loop End If Next Myc End Sub

  • VBA For To Next 文でComboBoxを指定?

    VBAでお世話になっています。 UserForm上のComboBox1~30の各値を元に Sheet2上のデータをSheet4上に貼り付けるVBAを組んであります。 ComboBox1の値を元に行なう作業(VBA)とComboBox30を元に行なう作業は同じなのですが、 但し記述は50行程×30あるので全記述をすると60kを超えてエラーになります。  ですので i = 0 For a = 1 To 30 従業員番号 = UserForm1.ComboBox a.Text + 10 'ここでエラー .CombBox a 反転表示 With Sheet4 .Cells(15 + i, 3).Value = Sheet2.Cells(従業員番号, 1).Value .Cells(17 + i, 3).Value = Sheet2.Cells(従業員番号, 2).Value .Cells(16 + i, 6).Value = Sheet2.Cells(従業員番号, 3).Value     ・     ・     ・ End with i=i+4 Next a としたら、「コンパイルエラー メソッド・データメンバが見つかりません」が返ります。 ComboBoxの番号を指定しないとわからんわい、との事と思います。 (a) "a" _a としてもだめですし、cmd=CombBox+aを足してみたら cmd=1になるし、 cmd="CombBox"+a は「型が一致しない」エラー・・・等々 なんとかCombBoxの1~30をFor文でループしたいのです。ご教授をお願いします。

  • VBA 検索するSheetの位置の変更

    現在、グループの数だけユーザー名の合計数をSheet2に抽出するという 事をやっているのですが....... コードの方は下記になります Sub Sample3() Dim i As Long, j As Long, k As Long, lastRow As Long, lastCol As Long Dim wS2 As Worksheet, wS3 As Worksheet Set wS2 = Worksheets("Sheet1") Set wS3 = Worksheets("Sheet2") Application.ScreenUpdating = False If wS2.Range("Y1") = "" Then wS2.Range("Y1") = "ダミー" End If With Worksheets("Sheet1") If .Range("A4") = "" Then .Range("A4") = "ダミー" End If lastRow = .Cells(Rows.Count, "B").End(xlUp).Row Range(.Cells(5, "B"), .Cells(lastRow, "B")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("B:B"), _ wS2.Cells(7, (i - 2) * 8 + 3)) If WorksheetFunction.CountIf(wS2.Columns((i - 2) * 8 + 2), wS2.Cells(k, (i - 2) * 8 + 2)) > 1 Then wS2.Cells(k, (i - 2) * 8 + 2).Resize(, 2).Delete shift:=xlUp End If Next k Next i wS2.Range("B1").CurrentRegion.Borders.LineStyle = xlContinuous wS2.Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole .Cells.Replace what:="ダミー", replacement:="", lookat:=xlWhole wS3.Cells.Clear .AutoFilterMode = False End With Application.ScreenUpdating = True End Sub このコードで検索をかけるSheet1のセルBの文字をセルCに移動して検索かけたいという事なのですが、下記の用なコードでBをCに変更してみた結果エラーが発生してしまいます。 lastRow = .Cells(Rows.Count, "C").End(xlUp).Row Range(.Cells(5, "C"), .Cells(lastRow, "C")).AdvancedFilter Action:=xlFilterCopy, copytorange:=wS3.Range("A1"), unique:=True '★ For i = 2 To wS3.Cells(Rows.Count, "A").End(xlUp).Row wS2.Cells(7, (i - 2) * 8 + 3) = wS3.Cells(i, "A") .Range("A4").AutoFilter field:=2, Criteria1:=wS3.Cells(i, "A") Range(.Cells(5, "AA"), .Cells(lastRow, "AA")).SpecialCells(xlCellTypeVisible).Copy wS2.Cells(7, (i - 2) * 8 + 2) For k = wS2.Cells(Rows.Count, (i - 2) * 8 + 2).End(xlUp).Row To 7 Step -1 wS2.Cells(k, (i - 2) * 8 + 3) = WorksheetFunction.CountIfs(.Range("AA:AA"), wS2.Cells(k, (i - 2) * 8 + 2), .Range("C:C"), _ どなたかご教授の方お願い致します。

  • COUNTIFS関数をVBAで使用したい

    お世話になります。 よろしくお願いいたします。 Sheet1に集計表、Sheet2にデーターがあります。 氏名とコードが合致するデーターの個数を出したいのですが、コードの書き方がわかりません。 ご教示をお願いいたします。 Sheet1のB列の最後に小計や合計が入っているため、A列使用。 COUNTIFS関数でコンパイルエラーがでます。 Sheet1 A    B   C    D 氏名 氏名 コード 合致する個数 Sheet2 B    J     N 氏名  コード   数値 Sub test1() Dim i As Long, t As Long Dim wS1 As Worksheet, wS2 As Worksheet Set wS1 = Worksheets("Sheet1") Set wS2 = Worksheets("Sheet2") i = wS1.Range("A" & Rows.Count).End(xlUp).Row t = wS2.Range("B" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For i = 5 To i Range(wS1.Cells(5, "D"), wS1.Cells(i, "D")).Formula = _ "=COUNTIFS(wS2.Range("B7:B"&t),B5,wS2.Range("J5:J"&t),C5)" Next i Application.ScreenUpdating = True End Sub

  • VBA 任意のシートからコピーを始める。

    教えてください。 全てのシートをコピーして一つのシートにまとめるプログラムシートを作成しました。 1番目のシートからコピーを始める場合は For i = 2 To Worksheets.Count 2番目のシートからコピーを始める場合は For i = 3 To Worksheets.Count とすればよいのですがこれだといちいちモジュールコードを出して数字を変更しなければならず面倒です。 そこでユーザーフォームのコンボボックスに任意の数字を入れてクリックを押せば希望するシートからコピーを始めるプログラムを作成してみましたがうまくいきません。どなたか教えてくださいませんか。 Sub matome() Dim i As Integer Dim lRow As Long, lCol As Long, lRow2 As Long, lRow3 As Long, SNo As Integer '----何番目からコピーを始めるかを決定します With UserForm2 SNo = .ComboBox1.value End With For i = 1 + SNo To Worksheets.Count With Worksheets(i) lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1 lCol = .Cells(1, Columns.Count).End(xlToLeft).Column '----シートのデータが2行以上の場合にコピーします If lRow >= 2 Then lRow2 = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1 If lRow2 < Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 Then lRow2 = Worksheets(1).Cells(Rows.Count, 5).End(xlUp).Row + 1 .Activate .Range(Cells(2, 1), Cells(lRow, lCol)).Copy Worksheets(1).Cells(lRow2, 1) End If End With Next i

専門家に質問してみよう