参照は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
No.3ベストアンサー
- 回答日時:
多分岐条件式は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
この回答への補足
本当にご丁寧ありがとうございます。
大変あつかましいとは思いますが、補足させていただきました。
条件bの部分で、
.Cells(i,8).Value-R.Value
が”オブジェクトはこのプロパティーまたはメソッドをサポートしていません。”というエラーが発生してしまいます。
また
Case(s=1)というのは、sが1以上でも対応するのでしょうか。それとも">"に置き換えたほうがいいのでしょうか。
またCells(i,8) Cells(i,9) Cells(i,22) Cells(i,23)のいずれかが空白である場合があります。それがマクロが動作しない理由であるのかどうか、自分で作ってみたものも、心配でした。
無知で、質問ばかり本当に申し訳ありません。
よろしければ、教えてください。
No.6
- 回答日時:
これほど複雑なことになると、文章を、図式化に近づけるとか表現方法を工夫してもらわないと、読者にわからない。
CASE文的に整理するとか(箇条書き的に整理するとか)。
またこんな長いコードをコピー貼り付けして、質問者のデバッグのために読者を動員するのは問題あると思う。
デバッグは基本的に自分でやるべきです。エラー箇所が煮詰まったら、それで原因がわからないときに投稿すべきです。
やっていることは、比較と加減算しかないようですし。
行全体削除は出来れば他のシートに書き出さないという方式の方が
思考的に安定性が在る、ForNextが使いづらくなるから。
行の1部列削除も実用上行って意味あるのかな。
テスト的にケース(条件合致類型)コードを1列設け、シート印刷して、そのプログラムによる、コード立てが正しいか、机上デバッグをしてみたら。それぐらい質問者は、工夫と努力をすべきだ。(大昔はエラーが起こると、何百ページもあるダンプシート(文字と16進表示)をにらめっこした時代もある。)
既回答者は良く善意で、付き合ってくれているなと思います。感謝しなければ。
確かにわかりにくく申し訳なかったと思っております。初心者ですので、デバッグひとつでも、解決方法がなかなかわからなく、ついこちらに頼ってしまいました。
今回親切にご回答してくださった方々に大変感謝し、またこれからの自分勉強にも生かしていくつもりです。ご指摘ありがとうございます。
No.5
- 回答日時:
まとめられるものはまとめて、不具合個所の修正してみました
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
- 回答日時:
> .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」として計算されます。スペースなどの空白文字が入っているとエラーになりますが、完全な空白(ブランク状態)であれば計算自体に支障はありません。
ご丁寧に、かつ親切にご回答いただきとても感謝しております。
とても勉強になると同時に、思っていたとおりのものができました。
かなり説明もわかりにくく申し訳なかったのですが、お付き合いいただきありがとうございます。
No.2
- 回答日時:
全部は見てませんが・・・
> 列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
ではないでしょうか?
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
- ・ゆるやかでぃべーと タイムマシンを破壊すべきか。
- ・歩いた自慢大会
- ・許せない心理テスト
- ・字面がカッコいい英単語
- ・これ何て呼びますか Part2
- ・人生で一番思い出に残ってる靴
- ・ゆるやかでぃべーと すべての高校生はアルバイトをするべきだ。
- ・初めて自分の家と他人の家が違う、と意識した時
- ・単二電池
- ・チョコミントアイス
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
B列の最終行までA列をオート...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
文字列の結合を空白行まで実行
-
IIF関数の使い方
-
【VBA】2つのシートの値を比較...
-
VBAで指定範囲内の空白セルを左...
-
エクセル 2つの表の並べ替え
-
VBAのFind関数で結合セルを検索...
-
マクロ 最終列をコピーして最終...
-
グリッドの列の最大値を求めたい。
-
データグリッドビューの一番最...
-
VBAで、離れた複数の列に対して...
-
DataGridViewに空白がある場合...
-
【Excel VBA】 B列に特定の文字...
-
エクセルで結合セルがあるため...
-
VBAで文字列を結合
-
VBA 列が空白なら別のマクロへ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
B列の最終行までA列をオート...
-
Worksheets メソッドは失敗しま...
-
Excelで、あるセルの値に応じて...
-
vba 2つの条件が一致したら...
-
Cellsのかっこの中はどっちが行...
-
URLのリンク切れをマクロを使っ...
-
文字列の結合を空白行まで実行
-
データグリッドビューの一番最...
-
【VBA】2つのシートの値を比較...
-
VBA 何かしら文字が入っていたら
-
IIF関数の使い方
-
VBAを使って検索したセルをコピ...
-
Changeイベントでの複数セルの...
-
VBAの構文 3列置きにコピーし...
-
VBAのFind関数で結合セルを検索...
-
【Excel VBA】 B列に特定の文字...
-
VBAで指定範囲内の空白セルを左...
-
VBAでのリスト不一致抽出について
-
セルに値が入っていた時の処理
-
VBAコンボボックスで選択した値...
おすすめ情報