Page 37 ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ 通常モードに戻る ┃ INDEX ┃ ≪前へ │ 次へ≫ ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ ▼複数のデータがすべて一致した場合のみ実行させるには Maria 02/9/4(水) 19:14 ┣Re:複数のデータがすべて一致した場合のみ実行させるには りん 02/9/4(水) 19:58 ┃ ┗Re:複数のデータがすべて一致した場合のみ実行させるには Maria 02/9/4(水) 23:59 ┃ ┣Re:複数のデータがすべて一致した場合のみ実行させるには ichinose 02/9/5(木) 7:48 ┃ ┃ ┗Re:複数のデータがすべて一致した場合のみ実行させるには りん 02/9/5(木) 7:55 ┃ ┗Re:複数のデータがすべて一致した場合のみ実行させるには りん 02/9/5(木) 7:53 ┗Re:複数のデータがすべて一致した場合のみ実行させるには Maria 02/9/5(木) 17:07 ─────────────────────────────────────── ■題名 : 複数のデータがすべて一致した場合のみ実行させるには ■名前 : Maria ■日付 : 02/9/4(水) 19:14 -------------------------------------------------------------------------
2つのシートに同様の形式でデータが並んでいる場合に、 すべてのデータが一致した場合のみ実行させるプログラムは どうやって組めばいいのでしょうか? 例えば、シート1、シート2にAからEまでのデータがあったとして、 A1=A2,B1=B2,C1=C2,D1=D2,E1=E2をすべて満たしたときのみ、 セルに色を付ける場合などです。 いろいろ試してみたのですが、どうもうまくいきません。 よろしくお願いします。 |
Mariaさん、こんばんわ。 >2つのシートに同様の形式でデータが並んでいる場合に、 >すべてのデータが一致した場合のみ実行させるプログラムは >どうやって組めばいいのでしょうか? >例えば、シート1、シート2にAからEまでのデータがあったとして、 >A1=A2,B1=B2,C1=C2,D1=D2,E1=E2をすべて満たしたときのみ、 >セルに色を付ける場合などです。 >いろいろ試してみたのですが、どうもうまくいきません。 > >よろしくお願いします。 Sheet1のA1-E10とSheet2のA1-E10を順番に比較する Sub Test() Dim Flg As Boolean, RR&, CC% '行ループ For RR& = 1 To 10 Flg = True '列ループ For CC% = 1 To 5 Flg = Flg And (Worksheets("Sheet1").Cells(RR&, CC%).Value = _ Worksheets("Sheet2").Cells(RR&, CC%).Value) Next '一致したら行全体をオレンジに If Flg = True Then Worksheets("Sheet1").Rows(RR&).Interior.ColorIndex = 44 Worksheets("Sheet2").Rows(RR&).Interior.ColorIndex = 44 End If Next End Sub こんな感じです。 |
うーんと、 この場合、1行目は全部合ってても、2行目に違うデータが混ざっている場合に 1行目に色が付いて2行目にはついていないということになりませんか? 1行目が全部合ってても、2行目に違うデータが混ざっている場合は 色が付かないようにしたいんです。 例えば、A1:E10の範囲内のデータがすべて一致したばあいのみ A1:E10に色が付き、1個でも違うものがあればつかない、という感じです。 説明不足で申し訳ありません。 複数の行列にわたるので、 私はいったんループでデータを変数に格納して、 それをぜんぶ比較するというマクロに挑戦してみたのですが、 うまくいきませんでした・・・(;−;) たぶん、私の知識不足なだけだとは思うのですが・・・。 |
▼Maria さん りんさん おはようございます。横レス、失礼します。 こんな方法ではどうでしょうか? worksheets(1)とworksheets(2)のA1:E10を比較させました。 '========================================================================= Sub test() Dim add1 As String Dim add2 As String Dim rng As Range With Worksheets(2) Set rng = Worksheets(1).Range("a1:e10") add1 = rng.Address add2 = .Name & "!" & .Range(add1).Address End With If Evaluate("sumproduct((" & add1 & "=" & add2 & ")*(" & add1 & "=" & add1 & "))") = rng.Count Then rng.Interior.ColorIndex = 6 Worksheets(2).Range(add1).Interior.ColorIndex = 6 Else rng.Interior.ColorIndex = xlNone Worksheets(2).Range(add1).Interior.ColorIndex = xlNone End If End Sub |
ichinose さん、おはようございます。 > If Evaluate("sumproduct(... SUMPRODUCTワークシート関数でも出来るのですか。さすがです。 |
Mariaさん、おはようございます。 >例えば、A1:E10の範囲内のデータがすべて一致したばあいのみ >A1:E10に色が付き、1個でも違うものがあればつかない、という感じです。 全部チェックしてから色を塗ればいいです。 Sub Test() Dim Flg As Boolean, RR&, CC% Dim Rmin&, Rmax&, Cmin%, Cmax% Dim r1 As Range, r2 As Range ' Rmin& = 1: Rmax& = 10 ' 1 to 10行 Cmin% = 1: Cmax% = 5 ' A to E列 '範囲1 With Worksheets("Sheet1") Set r1 = .Range(.Cells(Rmin&, Cmin%), .Cells(Rmax&, Cmax%)) End With '範囲2 With Worksheets("Sheet2") Set r2 = .Range(.Cells(Rmin&, Cmin%), .Cells(Rmax&, Cmax%)) End With ' 'ループ Flg = True For RR& = Rmin& To Rmax& For CC% = Cmin% To Cmax% Flg = Flg And (r1.Cells(RR&, CC%).Value = _ r2.Cells(RR&, CC%).Value) Next Next '完全一致したら If Flg = True Then r1.Interior.ColorIndex = 44 r2.Interior.ColorIndex = 44 End If ' Set r1 = Nothing: r2 = Nothing End Sub こんな感じです。 |
お二人様ありがとうございます! マクロ初級者ゆえ、理解したとはいえませんが(爆) コピペでチャレンジしてみます!(^−^)/ |