単二電池

参照は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を上方向に削除
   b 列8+列22>列9+列33 であり、かつ列8>列9 である場合
       r=列23の値 
       列8-r
       列13~列30のみを上方向に消去 
   c 列8+列22>列9+列33であり、かつ列8<列9である場合
       r=列23の値
       列9-r
       列13~列30のみを上方向に消去
   d 列8+列22<列9+列33であり、かつ列22>列23である場合
       r=列8の値
       列22-r
       列1~列11のみを上方向に消去
    e 列8+列22<列9+列33であり、かつ列22<列23である場合
       r=列8の値
       列9-r
       列1~列23のみを上方向に消去
条件2. 条件1以外は、次の行(n)へ移行する。
エラーにはならないのですが、マクロを作動させても、画面に反応がありません。基礎的な事がまだよく分かっていないので、単純なことかもしれませんが、どうしてもわかりません(涙)。
分かる方に教えていただこうと思い投稿させていただきました。よろしくお願いします。下記に、一応自分で作ったマクロを添付しています。
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

A 回答 (6件)

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



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

Case 条件2
条件2に一致

End Select

と書くと見た目がすっきりします。
また、同じ項を使った比較計算を何度も行っているので、そのようなものはまとめられます。
A=B, A>B, A<B これらは、Math.Sgnを使えばそれぞれ 0, 1, -1 という3つの数値に置き換えることが出来ます。
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)

' r=列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)

' r=列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)

' r=列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)

' r=列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
「複数項目が同じ値である場合いくつかの条件」の回答画像3

この回答への補足

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

補足日時:2009/08/21 16:22
    • good
    • 0

これほど複雑なことになると、文章を、図式化に近づけるとか表現方法を工夫してもらわないと、読者にわからない。


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

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

お礼日時:2009/08/23 01:17

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



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

サンプルで表を作成するのが面倒なので、テストしていません
参考程度に
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/08/23 01:13

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



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

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

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

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

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

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

お礼日時:2009/08/23 01:11

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



> 列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
 ではないでしょうか?
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/08/21 16:15

めんどくさ。



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

てか俺、今エクセルもってないし。くれたら見てあげる。
    • good
    • 0
この回答へのお礼

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

お礼日時:2009/09/01 13:09

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報