複数項目が同じ値である場合いくつかの条件の下で処理方法を変えたいのですが、どうしたらよいでしょうか。

質問

参照は1行ずつ下に移行します。6行目の列1から列11までが表1となっており、6行目の列13から列30までが表2になっています。列の項目内容は似ていますが、表2のほうが項目数は多くなっています。要は表1の行と表2の行の指定内容が一致した場合に、条件によって処理をするということがしたいのです。
列1(A)　　2　　　3　　　4...　　　　11(K)　　列13(M)　　14　　15　　16...　　30(AD)
日付　時刻　コード　委託者名　...　　日付　時刻　コード　委託者名...

マクロの内容としては

条件1.　列1と25M、列2と列26、列3と列15、列7と列S19が同じ値である場合
　　　a　　列8+列22＝列9+列23　である場合・・・列1~列11・列13~列30を上方向に削除
　　　ｂ　列8+列22＞列9+列33　であり、かつ列8＞列9　である場合
　　　　　　　ｒ＝列23の値　
　　　　　　　列8-ｒ
　　　　　　　列13~列30のみを上方向に消去　
　　　ｃ　列8+列22＞列9+列33であり、かつ列8＜列9である場合
　　　　　　　ｒ＝列23の値
　　　　　　　列9-ｒ
　　　　　　　列13~列30のみを上方向に消去
　　　ｄ　列8+列22＜列9+列33であり、かつ列22＞列23である場合
　　　　　　　ｒ＝列8の値
　　　　　　　列22-ｒ
　　　　　　　列1~列11のみを上方向に消去
　　　 e　列8+列22＜列9+列33であり、かつ列22＜列23である場合
　　　　　　　ｒ＝列8の値
　　　　　　　列9-ｒ
　　　　　　　列1~列23のみを上方向に消去
条件2.　条件1以外は、次の行（ｎ）へ移行する。
エラーにはならないのですが、マクロを作動させても、画面に反応がありません。基礎的な事がまだよく分かっていないので、単純なことかもしれませんが、どうしてもわかりません（涙）。
分かる方に教えていただこうと思い投稿させていただきました。よろしくお願いします。下記に、一応自分で作ったマクロを添付しています。
Sub Open_Positions2()
Dim n As Long
Dim i As Long
Dim r As Range
With Sheets("未決済")
For i = 6 To .Cells(Rows.Count, 1).End(xlUp).Row
For n = 6 To .Cells(Rows.Count, 13).End(xlUp).Row
If .Cells(i, 1).Value = .Cells(n, 25).Value And .Cells(i, 2).Value = .Cells(n, 26).Value And .Cells(i, 3).Value = .Cells(n, 14).Value And .Cells(i, 7).Value = .Cells(n, 19).Value Then
If .Cells(i, 8).Value + .Cells(n, 22).Value = .Cells(i, 9).Value + Cells(n, 23).Value Then
　　　　.Cells(i, 1).Resize(11).Delete Shift:=xlUp
.Cells(n, 13).Resize(18).Delete Shift:=xlUp
GoTo xyz
ElseIf .Cells(i, 8).Value + .Cells(n, 22).Value > .Cells(i, 9).Value + .Cells(n, 23).Value And .Cells(i, 8).Value > .Cells(i, 9) Then
Set r = .Cells(n, 23).Value
.Cells(i, 8).Value -r
.Cells(n, 13).Resize(18).Delete Shift:=xlUp
GoTo xyz
ElseIf .Cells(i, 8).Value + .Cells(n, 22).Value > .Cells(i, 9).Value + .Cells(n, 23).Value And .Cells(i, 8).Value < .Cells(i, 9) Then
Set r = .Cells(n, 23).Value
.Cells(i, 9).Value -r
.Cells(n, 13).Resize(18).Delete Shift:=xlUp
GoTo xyz
ElseIf .Cells(i, 8).Value + .Cells(n, 22).Value < .Cells(i, 9).Value + Cells(n, 23).Value And .Cells(n, 22).Value > .Cells(n, 23).Value Then
Set r = .Cells(i, 8).Value
.Cells(n, 22).Value -r
.Cells(i, 1).Resize(11).Delete Shift:=xlUp
ElseIf .Cells(i, 8).Value + .Cells(n, 22).Value < .Cells(i, 9).Value + Cells(n, 23).Value And .Cells(n, 22).Value < .Cells(n, 23).Value Then
Set r = .Cells(i, 8).Value
.Cells(n, 23).Value -r
.Cells(i, 1).Resize(11).Delete Shift:=xlUp
GoTo xyz
End If
Else
Debug.Print "Not Found"
End If
Next n
xyz:
Next i
End With
End Sub

回答No.3

うぃず（@Wizard_Zero） · ベストアンサー

多分岐条件式はIf～ElseIf～End If を連ねるよりも下記のように

Select Case True
Case 条件１
条件１に一致

Case 条件2
条件２に一致

End Select

と書くと見た目がすっきりします。
また、同じ項を使った比較計算を何度も行っているので、そのようなものはまとめられます。
A=B, A>B, A<B これらは、Math.Sgnを使えばそれぞれ 0, 1, -1 という３つの数値に置き換えることが出来ます。
For～Nextからの脱出もGotoを使わずにExit Forで解決できます。(Gotoはコーディングミスを招きやすいので極力使わないほうが良いです)

ミスっぽいところ
Dim r As Range
としているのに
Set r = .Cells(#, #).Value
となっているのはまずいです。

#2さんの指摘があった、条件とコードの違いもありますし、コードを整頓してもういちど見直す必要があると思います。

以上を踏まえ、気づいたところを修正しコメントを付加したコードです。合ってるかどうかは分かりません。
投稿するとインデントがつぶれてしまうので、てきとーに段下げしてください。

Sub Open_Positions2()
Dim n As Long
Dim i As Long
Dim R As Range
Dim s As Integer

With Sheets("未決済")

For i = 6 To .Cells(Rows.Count, 1).End(xlUp).Row
For n = 6 To .Cells(Rows.Count, 13).End(xlUp).Row

' 条件1. 列1と25M、列2と列26、列3と列15、列7と列19が同じ値である場合
If .Cells(i, 1).Value = .Cells(n, 25).Value And _
.Cells(i, 2).Value = .Cells(n, 26).Value And _
.Cells(i, 3).Value = .Cells(n, 15).Value And _
.Cells(i, 7).Value = .Cells(n, 19).Value Then

' 列8+列22 と 列9+列23 を比較
' sの値
' 列8+列22 = 列9+列23 のときは 0
' 列8+列22 > 列9+列23 のときは 1
' 列8+列22 < 列9+列23 のときは -1
s = Math.Sgn((.Cells(i, 8).Value + .Cells(n, 22).Value) - (.Cells(i, 9).Value + Cells(n, 23).Value))

Select Case True

' a. 列8+列22=列9+列23(s=0)
Case s = 0

' 列1~列11・列13~列30を上方向に削除
.Cells(i, 1).Resize(11).Delete Shift:=xlUp
.Cells(n, 13).Resize(18).Delete Shift:=xlUp

' b. 列8+列22>列9+列33(s=1) And 列8>列9
Case (s = 1) And (.Cells(i, 8).Value > .Cells(i, 9).Value)

' ｒ＝列23の値, 列8 -r, 列13～列30のみを上方向に消去
Set R = .Cells(n, 23)
.Cells(i, 8).Value -R.Value
.Cells(n, 13).Resize(18).Delete Shift:=xlUp

' c. 列8+列22>列9+列33(s=1) And 列8<列9
Case (s = 1) And (.Cells(i, 8).Value < .Cells(i, 9).Value)

' ｒ＝列23の値, 列9 -r, 列13~列30のみを上方向に消去
Set R = .Cells(n, 23)
.Cells(i, 9).Value -R.Value
.Cells(n, 13).Resize(18).Delete Shift:=xlUp

' d. 列8+列22<列9+列33(s=-1) And 列22>列23
Case (s = -1) And (.Cells(n, 22).Value > .Cells(n, 23).Value)

' ｒ＝列8の値, 列22 -r, 列1~列11のみを上方向に消去
Set R = .Cells(i, 8)
.Cells(n, 22).Value -R.Value
.Cells(i, 1).Resize(11).Delete Shift:=xlUp

' e. 列8+列22<列9+列33(s=-1) And 列22<列23
Case (s = -1) And (.Cells(n, 22).Value < .Cells(n, 23).Value)

' ｒ＝列8の値, 列9 -r, 列1~列23のみを上方向に消去
Set R = .Cells(i, 8)
.Cells(n, 23).Value -R.Value ' 9? 23?
.Cells(i, 1).Resize(11).Delete Shift:=xlUp '11? 23?

End Select

Exit For ' For～Next n を脱出

Else

Debug.Print "Not Found"
End If

Next n
Next i

End With

End Sub

補足

本当にご丁寧ありがとうございます。
大変あつかましいとは思いますが、補足させていただきました。
条件ｂの部分で、
.Cells(i,8).Value-R.Value
が”オブジェクトはこのプロパティーまたはメソッドをサポートしていません。”というエラーが発生してしまいます。
また
Case（s=1）というのは、ｓが1以上でも対応するのでしょうか。それとも"＞"に置き換えたほうがいいのでしょうか。
またCells(i,8) Cells(i,9) Cells(i,22) Cells(i,23)のいずれかが空白である場合があります。それがマクロが動作しない理由であるのかどうか、自分で作ってみたものも、心配でした。
無知で、質問ばかり本当に申し訳ありません。
よろしければ、教えてください。

回答No.6

imogasi

これほど複雑なことになると、文章を、図式化に近づけるとか表現方法を工夫してもらわないと、読者にわからない。
ＣＡＳＥ文的に整理するとか（箇条書き的に整理するとか）。
またこんな長いコードをコピー貼り付けして、質問者のデバッグのために読者を動員するのは問題あると思う。
デバッグは基本的に自分でやるべきです。エラー箇所が煮詰まったら、それで原因がわからないときに投稿すべきです。
やっていることは、比較と加減算しかないようですし。
行全体削除は出来れば他のシートに書き出さないという方式の方が
思考的に安定性が在る、ＦｏｒＮｅｘｔが使いづらくなるから。
行の1部列削除も実用上行って意味あるのかな。
テスト的にケース（条件合致類型）コードを１列設け、シート印刷して、そのプログラムによる、コード立てが正しいか、机上デバッグをしてみたら。それぐらい質問者は、工夫と努力をすべきだ。（大昔はエラーが起こると、何百ページもあるダンプシート（文字と１６進表示）をにらめっこした時代もある。）
既回答者は良く善意で、付き合ってくれているなと思います。感謝しなければ。

お礼

確かにわかりにくく申し訳なかったと思っております。初心者ですので、デバッグひとつでも、解決方法がなかなかわからなく、ついこちらに頼ってしまいました。
今回親切にご回答してくださった方々に大変感謝し、またこれからの自分勉強にも生かしていくつもりです。ご指摘ありがとうございます。

回答No.5

hige_082

まとめられるものはまとめて、不具合個所の修正してみました

Sub Open_Positions2()
Dim n As Long
Dim i As Long

With Sheets("未決済")

For i = 6 To .Cells(Rows.Count, 1).End(xlUp).Row
For n = 6 To .Cells(Rows.Count, 13).End(xlUp).Row

If .Cells(i, 1).Value = .Cells(n, 25).Value And .Cells(i, 2).Value = .Cells(n, 26).Value _
And .Cells(i, 3).Value = .Cells(n, 15).Value And .Cells(i, 7).Value = .Cells(n, 19).Value Then

Select Case .Cells(i, 8).Value + .Cells(n, 22).Value

Case Is = .Cells(i, 9).Value + Cells(n, 23).Value
.Cells(i, 1).Resize(11).Delete Shift:=xlUp
.Cells(n, 13).Resize(18).Delete Shift:=xlUp

Case Is > .Cells(i, 9).Value + .Cells(n, 23).Value
If .Cells(i, 8).Value > .Cells(i, 9) Then
.Cells(i, 8).Value = .Cells(i, 8).Value - .Cells(n, 23).Value
ElseIf .Cells(i, 8).Value < .Cells(i, 9) Then
.Cells(i, 9).Value = .Cells(i, 9).Value - .Cells(n, 23).Value
End If
If .Cells(i, 8).Value <> .Cells(i, 9) Then .Cells(n, 13).Resize(18).Delete Shift:=xlUp

Case Is < .Cells(i, 9).Value + Cells(n, 23).Value
If .Cells(n, 22).Value > .Cells(n, 23).Value Then
.Cells(n, 22).Value = .Cells(n, 22).Value - .Cells(i, 8).Value
ElseIf .Cells(n, 22).Value < .Cells(n, 23).Value Then
.Cells(n, 23).Value = .Cells(n, 23).Value - .Cells(i, 8).Value
End If
If .Cells(n, 22).Value <> .Cells(n, 23).Value Then .Cells(i, 1).Resize(11).Delete Shift:=xlUp
End Select

Exit For
Else
Debug.Print "Not Found"
End If

Next n
Next i
End With
End Sub

サンプルで表を作成するのが面倒なので、テストしていません
参考程度に

お礼

ありがとうございます。こういう書き方もあるのですね。とても勉強になり、またおおいに参考にもなりました。分かりにくい説明と、初心者の質問に丁寧にお付き合いいただき、本当に感謝しています。今後の勉強にも生かしていきたいおもいます。ありがとうございました。

回答No.4

うぃず（@Wizard_Zero）

> .Cells(i,8).Value -R.Value

見落としてました。Valueはプロパティなので代入式にする必要がありますね・・・。
.Cells(i,8).Value = -R.Value

> Case（s=1）というのは、ｓが1以上でも対応するのでしょうか。それとも"＞"に置き換えたほうがいいのでしょうか。

値sは、Sgn関数を使って求めたものです。Sgn関数は値の符号を0, 1, -1の３つの値で返します。よって、1を超える値が入ることは有り得ません。詳しくはヘルプでSgnを調べてみてください。

> またCells(i,8) Cells(i,9) Cells(i,22) Cells(i,23)のいずれかが空白である場合

空白のセルを計算式の中で参照すると「0」として計算されます。スペースなどの空白文字が入っているとエラーになりますが、完全な空白（ブランク状態）であれば計算自体に支障はありません。

お礼

ご丁寧に、かつ親切にご回答いただきとても感謝しております。
とても勉強になると同時に、思っていたとおりのものができました。
かなり説明もわかりにくく申し訳なかったのですが、お付き合いいただきありがとうございます。

回答No.2

goo39

全部は見てませんが・・・

>　列3と列15
>　.Cells(i, 3).Value = .Cells(n, 14).Value
→条件では15、関数では14になってますよ。

>　列1～列11を上方向に削除
>　.Cells(i, 1).Resize(11).Delete Shift:=xlUp
→.Range(.Cells(i, 1), .Cells(i, 11)).Delete Shift:=xlUp
　ではないでしょうか？

お礼

ご指摘ありがとうございます。ちゃんと確認してから投稿するべきですよね。すいませんでした。

回答No.1

JavaJavax2

めんどくさ。

一行ずつ実行して確認したらいいでしょう。

てか俺、今エクセルもってないし。くれたら見てあげる。

お礼

わざわざありがとうございます。
残念ながらエクセルがないなら結構ですので、わざわざコメントまでしてくださらなくていいですよ。