[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Nextに対応するForがありませんと出るのですが』（AR）
下記VBAを回そうとしているのですがNextに対応するForがありませんと出るのですが
何が足りていないのでしょうかすみませんがご教授ください
Sub データまとめ()
C = 1
T = 2
t2 = T - 1
y = 1
kT = 3
ky = 7
R = Worksheets("PowerQuery").Cells(Rows.Count, 2).End(xlUp).Row
Dim rowsData As Long
Cells(1, 1) = 7 - WorksheetFunction.CountIf(Worksheets("PowerQuery").Range("K" & T & ": P" & T), "")
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
Cells(kT, 2) = Worksheets("PowerQuery").Cells(T, y)
Cells(kT, 3) = Worksheets("PowerQuery").Cells(T, y + 2)
Cells(kT, 4) = Worksheets("PowerQuery").Cells(T, y + 3)
Cells(kT, 5) = Worksheets("PowerQuery").Cells(T, y + 5)
Cells(kT, 6) = Worksheets("PowerQuery").Cells(1, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
Dim i
Dim q
For i = 4 To R
If Worksheets("PowerQuery").Cells(T, y) = Worksheets("PowerQuery").Cells(t2, y) Then
If Worksheets("PowerQuery").Cells(T, y + 2) = Worksheets("PowerQuery").Cells(t2, y + 2) Then
If Worksheets("PowerQuery").Cells(T, y + 3) = Worksheets("PowerQuery").Cells(t2, y + 3) Then
If Worksheets("PowerQuery").Cells(T, y + 5) = Worksheets("PowerQuery").Cells(t2, y + 5) Then
If Worksheets("PowerQuery").Cells(T, y + 10) = "" Then
T = T + 1
Else
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
Else
ky = 7
kT = kT + 1
Cells(kT, 2) = Worksheets("PowerQuery").Cells(T, y)
Cells(kT, 3) = Worksheets("PowerQuery").Cells(T, y + 2)
Cells(kT, 4) = Worksheets("PowerQuery").Cells(T, y + 3)
Cells(kT, 5) = Worksheets("PowerQuery").Cells(T, y + 5)
Cells(kT, 6) = Worksheets("PowerQuery").Cells(1, y + 10)
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
Else
kT = kT + 1
ky = 7
Cells(kT, 2) = Worksheets("PowerQuery").Cells(T, y)
Cells(kT, 3) = Worksheets("PowerQuery").Cells(T, y + 2)
Cells(kT, 4) = Worksheets("PowerQuery").Cells(T, y + 3)
Cells(kT, 5) = Worksheets("PowerQuery").Cells(T, y + 5)
Cells(kT, 6) = Worksheets("PowerQuery").Cells(1, y + 10)
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
Next i
End Sub
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
Sub データまとめ()
c = 1
T = 2
t2 = T - 1
y = 1
kT = 3
ky = 7
r = Worksheets("PowerQuery").Cells(Rows.Count, 2).End(xlUp).Row
Dim rowsData As Long
Cells(1, 1) = 7 - WorksheetFunction.CountIf(Worksheets("PowerQuery").Range("K" & T & ": P" & T), "")
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
Cells(kT, 2) = Worksheets("PowerQuery").Cells(T, y)
Cells(kT, 3) = Worksheets("PowerQuery").Cells(T, y + 2)
Cells(kT, 4) = Worksheets("PowerQuery").Cells(T, y + 3)
Cells(kT, 5) = Worksheets("PowerQuery").Cells(T, y + 5)
Cells(kT, 6) = Worksheets("PowerQuery").Cells(1, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
Dim i
Dim q
For i = 4 To r
If Worksheets("PowerQuery").Cells(T, y) = Worksheets("PowerQuery").Cells(t2, y) Then
If Worksheets("PowerQuery").Cells(T, y + 2) = Worksheets("PowerQuery").Cells(t2, y + 2) Then
If Worksheets("PowerQuery").Cells(T, y + 3) = Worksheets("PowerQuery").Cells(t2, y + 3) Then
If Worksheets("PowerQuery").Cells(T, y + 5) = Worksheets("PowerQuery").Cells(t2, y + 5) Then
If Worksheets("PowerQuery").Cells(T, y + 10) = "" Then
T = T + 1
Else
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
Else
ky = 7
kT = kT + 1
Cells(kT, 2) = Worksheets("PowerQuery").Cells(T, y)
Cells(kT, 3) = Worksheets("PowerQuery").Cells(T, y + 2)
Cells(kT, 4) = Worksheets("PowerQuery").Cells(T, y + 3)
Cells(kT, 5) = Worksheets("PowerQuery").Cells(T, y + 5)
Cells(kT, 6) = Worksheets("PowerQuery").Cells(1, y + 10)
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
Else
kT = kT + 1
ky = 7
Cells(kT, 2) = Worksheets("PowerQuery").Cells(T, y)
Cells(kT, 3) = Worksheets("PowerQuery").Cells(T, y + 2)
Cells(kT, 4) = Worksheets("PowerQuery").Cells(T, y + 3)
Cells(kT, 5) = Worksheets("PowerQuery").Cells(T, y + 5)
Cells(kT, 6) = Worksheets("PowerQuery").Cells(1, y + 10)
Cells(kT, ky) = Worksheets("PowerQuery").Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
Next i
End Sub
（xyz） 2023/04/05(水) 11:48:25
馬鹿正直にこれに反応してはダメだよ。
（名無し） 2023/04/05(水) 11:57:26
For...Next If...End If With...End With
これらがちゃんとできているか調べてみましょう。
（火災報知器） 2023/04/05(水) 12:17:17
If aaa Then
と書いたら、
If aaa Then
end if
と初めに書いておくのも手。
私は、こうしてます。
（三個） 2023/04/05(水) 12:37:19
Select caseに変更するっていうのもありかも
Sub データまとめ()
Dim wsPQ As Worksheet: Set wsPQ = Worksheets("PowerQuery")
Dim c As Long, T As Long, t2 As Long, y As Long
Dim kT As Long, ky As Long
Dim r As Long
Dim i As Long
Dim q As Long
c = 1
T = 2
t2 = T - 1
y = 1
kT = 3
ky = 7
r = wsPQ.Cells(Rows.Count, 2).End(xlUp).Row
Dim rowsData As Long
Cells(1, 1) = 7 - WorksheetFunction.CountIf(wsPQ.Range("K" & T & ": P" & T), "")
Cells(kT, ky) = wsPQ.Cells(T, y + 10)
Cells(kT, 2) = wsPQ.Cells(T, y)
Cells(kT, 3) = wsPQ.Cells(T, y + 2)
Cells(kT, 4) = wsPQ.Cells(T, y + 3)
Cells(kT, 5) = wsPQ.Cells(T, y + 5)
Cells(kT, 6) = wsPQ.Cells(1, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
For i = 4 To r
Select Case False
Case wsPQ.Cells(T, y) = wsPQ.Cells(t2, y)
'何もしない
Case wsPQ.Cells(T, y + 2) = wsPQ.Cells(t2, y + 2)
'何もしない
Case wsPQ.Cells(T, y + 3) = wsPQ.Cells(t2, y + 3)
'y + 3 より前がTrue且つ、y + 3がFalseの場合の処理
kT = kT + 1
ky = 7
Cells(kT, 2) = wsPQ.Cells(T, y)
Cells(kT, 3) = wsPQ.Cells(T, y + 2)
Cells(kT, 4) = wsPQ.Cells(T, y + 3)
Cells(kT, 5) = wsPQ.Cells(T, y + 5)
Cells(kT, 6) = wsPQ.Cells(1, y + 10)
Cells(kT, ky) = wsPQ.Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
Case wsPQ.Cells(T, y + 5) = wsPQ.Cells(t2, y + 5)
'y + 5 より前がTrue且つ、y + 5がFalseの場合の処理
ky = 7
kT = kT + 1
Cells(kT, 2) = wsPQ.Cells(T, y)
Cells(kT, 3) = wsPQ.Cells(T, y + 2)
Cells(kT, 4) = wsPQ.Cells(T, y + 3)
Cells(kT, 5) = wsPQ.Cells(T, y + 5)
Cells(kT, 6) = wsPQ.Cells(1, y + 10)
Cells(kT, ky) = wsPQ.Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
Case Else
'上記がすべてTrueの場合の処理
If wsPQ.Cells(T, y + 10) = "" Then
T = T + 1
Else
Cells(kT, ky) = wsPQ.Cells(T, y + 10)
ky = ky + 1
T = T + 1
t2 = T - 1
End If
End Select
Next
End Sub
13:35シートの変数が中途半端に置換されていたので修正
（稲葉） 2023/04/05(水) 12:52:20
Sub 結果まとめ()
c = 1
t = 2
t2 = t - 1
y = 1
kT = 3
ky = 5
r = Worksheets("test").Cells(Rows.Count, 2).End(xlUp).Row
Dim rowsData As Long
Cells(1, 1) = 7 - WorksheetFunction.CountIf(Worksheets("test").Range("C" & t & ": I" & t), "")
Cells(kT, ky) = Worksheets("test").Cells(t, y + 2)
Cells(kT, 2) = Worksheets("test").Cells(t, y)
Cells(kT, 3) = Worksheets("test").Cells(t, y + 1)
Cells(kT, 4) = Worksheets("test").Cells(1, y + 2)
ky = ky + 1
t = t + 1
t2 = t - 1
Dim i
Dim q
For i = 4 To r
If Worksheets("test").Cells(t, y) = Worksheets("test").Cells(t2, y) Then
If Worksheets("test").Cells(t, y + 1) = Worksheets("test").Cells(t2, y + 1) Then
If Worksheets("test").Cells(t, y + 2) = "" Then
t = t + 1
Else
Cells(kT, ky) = Worksheets("test").Cells(t, y + 2)
ky = ky + 1
t = t + 1
t2 = t - 1
End If
Else
ky = 5
kT = kT + 1
Cells(kT, 2) = Worksheets("test").Cells(t, y)
Cells(kT, 3) = Worksheets("test").Cells(t, y + 1)
Cells(kT, 4) = Worksheets("test").Cells(1, y + 2)
Cells(kT, ky) = Worksheets("test").Cells(t, y + 2)
ky = ky + 1
t = t + 1
t2 = t - 1
End If
Else
kT = kT + 1
ky = 5
Cells(kT, 2) = Worksheets("test").Cells(t, y)
Cells(kT, 3) = Worksheets("test").Cells(t, y + 1)
Cells(kT, 4) = Worksheets("test").Cells(1, y + 2)
Cells(kT, ky) = Worksheets("test").Cells(t, y + 2)
ky = ky + 1
t = t + 1
t2 = t - 1
End If
Next i
End Sub
（AR） 2023/04/05(水) 14:13:03
皆して散々言っているの分かってんの？ 皆さんのご意見・ご忠告ちゃんと聞いたらどないやねん。
（名無し） 2023/04/05(水) 15:14:48
Sub データまとめ()
Dim ws As Worksheet
Dim T As Long, t2 As Long
Dim kt As Long, ky As Long
Dim R As Long, y As Long
Dim buf As Boolean
'転記元シートを設定
Set ws = Worksheets("PowerQuery")
'転記元最終行を設定
R = ws.Cells(Rows.Count, 2).End(xlUp).Row - 1
'転記元先頭列を設定
y = 1
'転記先先頭行-1を設定（転記部分のコードで転記前に+1するため）
kt = 2
'転記元先頭行から最終行まで巡回
For T = 2 To R
'転記判定をリセット
buf = False
'比較行が設定されているかで分岐
If t2 > 0 Then
'比較行が設定されている（1以上）場合は転記元行の値と比較行の値を比較する
'転記元の4つの列（基準列、基準列+2、基準列+3、基準列+5）の値を比較行の同一列の値と比較し
'一つ以上異なる値がある（「すべて同一」ではない）場合は転記判定をTrue
buf = (ws.Cells(T, y) <> ws.Cells(t2, y) Or _
ws.Cells(T, y + 2) <> ws.Cells(t2, y + 2) Or _
ws.Cells(T, y + 3) <> ws.Cells(t2, y + 3) Or _
ws.Cells(T, y + 5) <> ws.Cells(t2, y + 5))
Else
'比較行が設定されていない場合は転記判定をTrueにする（転記元先頭行のみ）
buf = True
End If
'転記判定Trueの場合
If buf Then
'転記先の行を+1
kt = kt + 1
'転記先最終列を7にリセット
ky = 7
'アクティブシートのB〜F列（のkt行）に転記元T行の4つの列の値及び転記元基準列+10列目の1行目の値を転記
Cells(kt, 2) = ws.Cells(T, y)
Cells(kt, 3) = ws.Cells(T, y + 2)
Cells(kt, 4) = ws.Cells(T, y + 3)
Cells(kt, 5) = ws.Cells(T, y + 5)
Cells(kt, 6) = ws.Cells(1, y + 10)
'転記した行を比較行に再設定（次行はこの転記行と比較する）
t2 = T
End If
'転記判定True、または転記元基準列+10列T行目の値が""出ない場合は
'（上記で転記しなかった（4つの列が上の行と同一）でy+10列に値がある場合はその値を最終列+1に転記する）
If buf Or ws.Cells(T, y + 10) <> "" Then
'転記先最終列に転記
Cells(kt, ky) = ws.Cells(T, y + 10)
'転記先最終列を一列右に移す
ky = ky + 1
End If
Next
End Sub
なんとなくこんな感じと想像。
（火災報知器） 2023/04/05(水) 15:15:56 ※20:45コード修正
（arar） 2023/04/05(水) 15:32:34
Sub データまとめ()
Dim mWs As Worksheet
Dim mTLCell As Range
Dim sTLCell As Range, sTRCell As Range
Dim cprVar1(3) As Variant, cprVar2(3) As Variant
Dim mData1 As String, mData2 As String
Dim mTopRow As Long, mLastRow As Long
Dim mTopColumn As Long
Dim mRow As Long
Dim i As Long
Dim buf As Boolean
'転記元シートを設定
Set mWs = Worksheets("PowerQuery")
'転記元先頭行を設定
mTopRow = 2
'転記元最終行を設定
mLastRow = mWs.Cells(Rows.Count, "B").End(xlUp).Row - 1
'転記元先頭列を設定
mTopColumn = 1
'転記用変数１にデータ入力
mData1 = mWs.Cells(1, mTopColumn).Offset(, 10).Value
'転記先先頭セルを設定
Set sTLCell = ActiveSheet.Range("B3")
'転記先末端列を転記先基準セルから６列目に設定
Set sTRCell = sTLCell.Offset(, 5)
'転記先A1セルにデータ転記
ActiveSheet.Cells(1, 1) = 7 - WorksheetFunction.CountIf(mWs.Range("K" & mTopRow & ": P" & mTopRow), "")
'転記元先頭行から最終行まで巡回
For mRow = mTopRow To mLastRow
'転記元先頭セルを設定
With mWs.Cells(mRow, mTopColumn)
'転記判定用比較配列１にデータを入力
cprVar1(0) = .Value
cprVar1(1) = .Offset(, 2).Value
cprVar1(2) = .Offset(, 3).Value
cprVar1(3) = .Offset(, 5).Value
'転記用変数２にデータ入力
mData2 = .Offset(, 10).Value
End With
'比較用配列１と２が「すべて同一」ではない場合は転記判定をTrue
For i = 0 To 3
buf = (cprVar1(i) <> cprVar2(i))
If buf Then Exit For
Next
'転記判定
If buf Then
'転記先基準セルから4列に比較用配列1のデータを入力
For i = 0 To 3
sTLCell.Offset(, i).Value = cprVar1(i)
'比較用配列２に比較用配列１のデータを代入
cprVar2(i) = cprVar1(i)
Next
'転記先基準セルから5列目に転記用変数１のデータを入力
sTLCell.Offset(, 4).Value = mData1
'転記先末端列を転記先基準セルから６列目にリセット
Set sTRCell = sTLCell.Offset(, 5)
'転記先基準セルを一つ下の行に移す
Set sTLCell = sTLCell.Offset(1)
End If
'転記用変数２が空白でなければ
If mData2 <> "" Then
'転記先末端列に転記
sTRCell.Value = mData2
'転記先末端列を一列右に移す
Set sTRCell = sTRCell.Offset(, 1)
End If
Next
End Sub
20:45のものと処理内容は大きく変わっていません
（火災報知器） 2023/04/05(水) 22:28:17
言わずもがなと思っていましたが、念のため。
インデントは非常に重要です。 コードの構造がわかりやすくなるので是非きちんとつけることを推奨します。 最初のコードでは、そこがわかりにくく、ハンディキャップを背負っているようなものです。
コードを記入してエンターを押すと、前行と同じ個所にカーソルが行きます。 段下げには、スペースキーではなく、タブキーを使って下さい。（一段上げるにはシフト＋タブ です） そうすれば、普通はインデントが揃いまし、スペースで余計な神経を使う必要もありません。
IFと End Ifは同数が無いといけません。（一行で終わるIfステートメントはその限りではありませんが。） 今回はEnd Ifが足りていないので、そのメッセージが出ました。 Nextにとっては思わぬ濡れ衣ですな。 同一もしくは、それ以下の深さのコードの中に、そのNextに対する Forが見つからないので、その指摘だされたのでしょう。 根本原因は If と End Ifの対が不完全だったからです。
ロジックを分かりやすいものにする方法も大切ですが、 上記の基本もきちんと押さえることを推奨します。 今後も常に出てくる話ですから。 （xyz） 2023/04/07(金) 07:36:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.