Results of 1 - 1 of about 37655 for IF (0.007 sec.)
- [[20120417121849]]
- #score: 1592
- @digest: f7bed429c6eb80f0978ff38a59f873b8
- @id: 58592
- @mdate: 2012-04-20T07:12:10Z
- @size: 31038
- @type: text/plain
- #keywords: blnmatch (157767), lngrowsc (148863), 較回 (50781), lngrowsa (48740), 得ln (15863), 比較 (10708), cells (9346), interior (8511), 列変 (8142), 印が (7827), colorindex (7002), らif (6204), isempty (5153), 較す (4521), value (4496), 除外 (4464), 一致 (3959), 終行 (3648), 処理 (3355), ープ (3139), 変数 (3138), 回数 (3019), ルー (2862), then (2652), 最終 (2601), コー (2511), 列の (2460), ubound (2369), 無い (2280), xlup (2251), boolean (2207), て行 (2200)
- 『For文を2つ繰り返したいのですが』（NAGI）
For文を使って、A列にあってC列に無いもののチェックをしました For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 3).End(xlUp).Row If .Cells(i, 1).Value = .Cells(j, 3).Value Then flg = True Exit For End If End If Next j If flg Then flg = False Else Cells(i, 1).Interior.ColorIndex = 6 End IF Next i これに続けて、C列にあってA列にないものをチェックしようとして、上のコードの下に i と j の位置を入れ替えたコードを書いたのですが、上のFor文だけで終わってしまい、 下のFor文（C列にあってA列にないものをチェックするコード）に行きません。 このような場合どのようにコードを書けばいいのでしょうか ---- i と j の位置を入れ替えた・・・ ⇒ 1 と 3 を入れ替えないとだめなんじゃない? あと、j をカウンタ変数としたループの中で End If がひとつ多いと重います。 (ROUGE) Sub Trial() Dim tblA, tblC, x, ky, i As Long tblA = Range("A3", Range("A" & Rows.Count).End(xlUp)).Value tblC = Range("C3", Range("C" & Rows.Count).End(xlUp)).Value With CreateObject("Scripting.Dictionary") For i = 1 To UBound(tblA, 1) If .Exists(tblA(i, 1)) Then x = .Item(tblA(i, 1)) If Len(x(UBound(x))) > 245 Then ReDim Preserve x(UBound(x) + 1) End If x(UBound(x)) = x(UBound(x)) & ",A" & i + 2 .Item(tblA(i, 1)) = x Else .Add tblA(i, 1), Array(",A" & i + 2) End If Next For i = 1 To UBound(tblC, 1) If .Exists(tblC(i, 1)) Then .Remove tblC(i, 1) Next For Each ky In .Keys x = .Item(ky) For i = 0 To UBound(x) Range(Mid$(x(i), 2)).Interior.ColorIndex = 6 Next Next .RemoveAll For i = 1 To UBound(tblC, 1) If .Exists(tblC(i, 1)) Then x = .Item(tblC(i, 1)) If Len(x(UBound(x))) > 245 Then ReDim Preserve x(UBound(x) + 1) End If x(UBound(x)) = x(UBound(x)) & ",C" & i + 2 .Item(tblC(i, 1)) = x Else .Add tblC(i, 1), Array(",C" & i + 2) End If Next For i = 1 To UBound(tblA, 1) If .Exists(tblA(i, 1)) Then .Remove tblA(i, 1) Next For Each ky In .Keys x = .Item(ky) For i = 0 To UBound(x) Range(Mid$(x(i), 2)).Interior.ColorIndex = 6 Next Next End With End Sub ---- 質問の趣旨から外れますが、似たような処理をする場合は処理を二回書くより 処理対象を変えて同じ処理を利用できるようにするのも便利な方法です。 (Mook) 一応、サンプルです。 Sub Sample() Dim rangeA As Range Dim rangeC As Range With ActiveSheet Set rangeA = .Range(.Cells(3, "A"), .Cells(Rows.Count, "A").End(xlUp)) Set rangeC = .Range(.Cells(3, "C"), .Cells(Rows.Count, "C").End(xlUp)) End With MyComp rangeA, rangeC MyComp rangeC, rangeA End Sub Sub MyComp(srcRange As Range, dstRange As Range) Dim objDic Set objDic = CreateObject("Scripting.Dictionary") For Each r In srcRange If objDic.Exists(r.Value) = True Then objDic(r.Value) = objDic(r.Value) + 1 Else objDic(r.Value) = 1 End If Next For Each r In dstRange If objDic.Exists(r.Value) = False Then r.Interior.ColorIndex = 6 End If Next End Sub ---- 「End If」が一つ余計です Option Explicit Public Sub Test() Dim i As Long Dim j As Long Dim flg As Boolean With ActiveSheet For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 3).End(xlUp).Row If .Cells(i, 1).Value = .Cells(j, 3).Value Then flg = True Exit For End If ' End If Next j If flg Then flg = False Else .Cells(i, 1).Interior.ColorIndex = 6 End If Next i For i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(i, 3).Value = .Cells(j, 1).Value Then flg = True Exit For End If Next j If flg Then flg = False Else .Cells(i, 3).Interior.ColorIndex = 6 End If Next i End With End Sub 別な方法で 一致した時、D列に印を入れ 次のLoopで印の無い行がC列で一致していない物なのでColorを代えます 尚、正統的な書き方ではFlagを立てる様ですが、ループカウンタjの値を見れば ループの途中で抜けたか?、最後迄回ったか?は判断出来るので変数flgは立てていません Public Sub Test_2() Dim i As Long Dim j As Long Dim lngEndA As Long Dim lngEndC As Long With ActiveSheet lngEndA = .Cells(Rows.Count, 1).End(xlUp).Row lngEndC = .Cells(Rows.Count, 3).End(xlUp).Row For i = 3 To lngEndA For j = 3 To lngEndC If .Cells(i, 1).Value = .Cells(j, 3).Value Then Exit For End If Next j 'jのループを途中で抜けたなら（一致する物が在ったら） If j <= lngEndC Then 'D列に印を入れる .Cells(i, "D").Value = 1 Else .Cells(i, 1).Interior.ColorIndex = 6 End If Next i For i = 3 To lngEndC 'D列に印が無いなら If .Cells(i, "D").Value <> 1 Then .Cells(i, 3).Interior.ColorIndex = 6 End If Next i 'D列を消去 .Range(.Cells(3, "D"), .Cells(lngEndC, "D")).ClearContents End With End Sub (Bun) ---- すみません、 End If が一つ多いのは本来のコードの条件分岐が他にもあって、その消し忘れです… あと、 >1 と 3 を入れ替えないとだめなんじゃない? これは入れ替えました。 それで、A列にあってC列にないものをチェックした時と、C列にあってA列にないものをチェックした時の 処理条件が実際は複雑に異なっていて、私がマクロの知識に乏しいので皆さまにお教えいただいたコードで 応用ができません… 実際のコードはすごく長いので、一部分抜粋しますが、 With Sheets("Sheet1") For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 3).End(xlUp).Row If .Cells(i, 2).Value <> "" And .Cells(i, 2).Value <> "○" And .Cells(j, 4).Value <> "" And .Cells(j, 4).Value <> "○" Then If .Cells(i, 1).Value = .Cells(j, 3).Value Then flg = True Exit For End If End If Next j If flg Then ★処理A flg = False Else ★処理B End If Next i For j = 3 To .Cells(Rows.Count, 3).End(xlUp).Row For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(i, 2).Value <> "" And .Cells(i, 2).Value <> "○" And .Cells(j, 4).Value <> "" And .Cells(j, 4).Value <> "○" Then If .Cells(j, 3).Value = .Cells(i, 1).Value Then flg2 = True Exit For End If End If Next i If flg2 Then flg2 = False Else ★処理C End If Next j End With これでコードを実行しましたが上のコードしか処理されません。 あと、他の列にもデータが入ってるので作業列は極力使いたくないです。 何故下のコードは無視されるのでしょう （NAGI） ---- i と j が指す列をもう一度注意してみてみてください。 二つの処理は、同じ処理になっています。 (Mook) ---- 下のコードを For i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(j, 2).Value <> "" And .Cells(j, 2).Value <> "○" And .Cells(i, 4).Value <> "" And .Cells(i, 4).Value <> "○" Then If .Cells(i, 3).Value = .Cells(j, 1).Value Then flg2 = True Exit For End If End If Next j If flg2 Then flg2 = False Else ★処理C End If Next i にしました。 If .Cells(i, 3).Value = .Cells(j, 1).Value Then 'C列を見て行ってA列に同じものがあったら flg2 = True '何もしない Exit For End If End If Next j If flg2 Then flg2 = False Else '違っていたら ★処理C '処理Cをする End If ??? すみません…分かりません… ステップ実行しても下のコードに行かないんです… If .Cells(i, 1).Value = .Cells(j, 3).Value Then If .Cells(i, 3).Value = .Cells(j, 1).Value Then これは同じ処理にみなされるんでしょうか? (NAGI) ---- 混乱させたようですみません。 iとjをクロスしていたので、こちらが見間違えたようです。 ですが、ステップ実行していかないということは、そのときの変数を見ればわかると 思うのですが、For 文の中も実行されないということでしょうか。 ステップ実行していったときに、i と j の指すセルは意図した位置になっていますか? 見た範囲では問題なさそうなので、提示されていない部分に問題があるようにも思いますが。 (Mook) ---- ステップ実行した時に、上のFor文で、jの値（C列）が最後の行に行ったところでマクロが終了してしまいます。 上の部分は意図した位置になっているのですが… jの値をよく見ていると、.Cells(Rows.Count, 3).End(xlUp).Row の位置に来たところで、iとjと両方が初期値に戻ってしまいます… もう一度コードを見直してみます… （NAGI） ---- コードを見直してみました。 If .Cells(j, 2).Value <> "" And .Cells(j, 2).Value <> "○" And .Cells(i, 4).Value <> "" And .Cells(i, 4).Value <> "○" Then この部分で、元のシートには何も値が入っていないのに .Cells(j, 2).Value <> "" が判定されないようです。 （例えば B15セルは空白なのに、空白とみなされない） 何故何も入っていないセルが空白にならないのかが今度は謎です… （NAGI) ---- B,D 列に関しては説明されていないので、このあたりとの関連は不明ですが、 下記の Sample2 のコードで、こちらの用意したサンプル（単純に同じ数値列の一部を変更した だけのもの）では動作しました。 ご自身で書かれているように、データ起因だと思いますが空白に見える部分にスペースが あるというようなことはないでしょうか。 数式がある場合は B15 の中身を提示するかあるいは、下記で 0 が表示されるかを確認 できますか? Sub CheckB15() MsgBox Len(Range("B15").Value) End Sub Sub Sample2() With Sheets("Sheet1") For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 3).End(xlUp).Row If .Cells(i, 2).Value <> "" And .Cells(i, 2).Value <> "○" And .Cells(j, 4).Value <> "" And .Cells(j, 4).Value <> "○" Then If .Cells(i, 1).Value = .Cells(j, 3).Value Then flg = True Exit For End If End If Next If flg Then flg = False Else .Cells(i, 1).Interior.ColorIndex = 6 End If Next For i = 3 To .Cells(Rows.Count, 3).End(xlUp).Row For j = 3 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(j, 2).Value <> "" And .Cells(j, 2).Value <> "○" And .Cells(i, 4).Value <> "" And .Cells(i, 4).Value <> "○" Then If .Cells(i, 3).Value = .Cells(j, 1).Value Then flg2 = True Exit For End If End If Next If flg2 Then flg2 = False Else .Cells(i, 3).Interior.ColorIndex = 6 End If Next End With End Sub ---- ありがとうございます。 Sub CheckB15() MsgBox Len(Range("B15").Value) End Sub を実行したところ「0」が表示されました。 そして繋げ方に問題があったのに気が付きましたので、 If .Cells(j, 2).Value <> "" And .Cells(j, 2).Value <> "○" And .Cells(i, 4).Value <> "" And .Cells(i, 4).Value <> "○" Then これの And を全部 Or で試したところサンプルコードではうまくいきましたが、実際のコードではうまくいきません 何となく原因は分かってきたのでもう一度チャレンジします (NAGI) ---- Or にしたら、If の意味がありませんよ。 一つのセルが 空白で かつ ○ がある なんてケースはありえませんから、すべてのセルで 実行されてしまいます。 B 列と D列が 空白でなく、○でもないとき（○以外の何かが入力されているとき）に 比較を実施、 という意図であれば、And でなければまずいと思います。 条件が意図と異なっているのでしたら、まず言葉で説明してはどうでしょうか。 (Mook) ---- Mook様 >B 列と D列が 空白でなく、○でもないとき（○以外の何かが入力されているとき） →A列にあってC列にないもの、A列とC列両方にあるもの、C列にあってA列にないもの の3パターンに分けたいんです。 それで上のSample2のコードを実行した時、A列・C列の3行目以降の全てのセルが黄色になってしまうんです。 Orで繋いだらA列にしかないものとC列にしかないものが黄色になったのでそれが正しいのかと… 確かにOrでは全てのセルで実行されてしまいますよね… 簡易テスト用のレイアウトは下記の通りです。 A B C D 1 見出し_1 2 比較A ○ 比較C ○ 3 AA AA 4 BB CC 5 DD EE 6 EE FF 7 GG GG 8 KK HH 9 KK 10 LL 11 MM 12 NN 13 OO 14 見出し_2 15 比較A ○ 比較C ○ 16 11A 12A 17 12A 13A 18 14A 14A 19 15A こんな感じで比較しています。 それで上のコードを実行すると、A3〜A18、C3〜C19が全部黄色になります… （NAGI) ---- 他は見ていませんが、もしかしてやりたいことは If .Cells(j, 2).Value <> "" And .Cells(j, 2).Value <> "○" And .Cells(i, 4).Value <> "" And .Cells(i, 4).Value <> "○" Then ではなく、 If .Cells(j, 1).Value <> "" And .Cells(j, 2).Value <> "○" And .Cells(i, 3).Value <> "" And .Cells(i, 4).Value <> "○" Then ではないですか? どうも説明とコードに食い違いがありそうなので、実際に試したコードそのものを 一度提示してはどうでしょうか。 上記のセルの例とあわせてみれば、適切なコメントが出来るかと思います。 (Mook) ---- こう成るのかな? [[20120417121849]] 『For文を2つ繰り返したいのですが』（NAGI) で同じ様な事をしたので Option Explicit Public Sub Sample_3() ' 逐次探索（リニアサーチ） Dim i As Long Dim j As Long Dim lngRowsA As Long 'A列の最終行 Dim lngRowsC As Long 'C列の最終行 Dim blnMatch() As Boolean With Worksheets("Sheet1") 'A列の最終行を取得 lngRowsA = .Cells(Rows.Count, 1).End(xlUp).Row 'C列の最終行を取得 lngRowsC = .Cells(Rows.Count, 3).End(xlUp).Row 'Matchしたらチェックする変数を確保 ReDim blnMatch(3 To lngRowsC) 'A列のLisを上から見て行く For i = 3 To lngRowsA 'C列のListを上から見て行く For j = 3 To lngRowsC 'A列とE列の値の先頭2文字を比較する If .Cells(i, 1).Value = .Cells(j, 3).Value Then 'チックが無いなら If Not blnMatch Then '比較値が同じならForを抜ける Exit For End If End If Next j 'C列のループを途中抜けたなら(同一の値が在った時) If j <= lngRowsC Then If Not IsEmpty(.Cells(i, 2).Value) _ And .Cells(i, 2).Value <> "○" _ And Not IsEmpty(.Cells(j, 4).Value) _ And .Cells(j, 4).Value <> "○" Then 'Matchした時の処理を行う .Cells(i, 1).Interior.ColorIndex = 7 .Cells(j, 3).Interior.ColorIndex = 7 End If 'FlagにMatchした印を入れる blnMatch(j) = True 'C列のループを回り切ったなら(同一の値が無かった時) Else If Not IsEmpty(.Cells(i, 2).Value) _ And .Cells(i, 2).Value <> "○" Then 'A列にしか無い場合の処理 .Cells(i, 1).Interior.ColorIndex = 34 End If End If Next i '※上記ループでは検出できないC列にだけ在るレコードを処理 'C列のListを上から見て行く For i = 3 To lngRowsC 'チックFlagに付けた印が無いなら(Matchした物以外なら) If Not blnMatch(i) Then If Not IsEmpty(.Cells(i, 4).Value) _ And .Cells(i, 4).Value <> "○" Then '片方にしか無い場合の処理 .Cells(i, 3).Interior.ColorIndex = 35 End If End If Next i End With MsgBox "処理が完了しました", vbInformation End Sub (Bun) ---- 間違った [[20120417121849]] 『For文を2つ繰り返したいのですが』（NAGI） では無く [[20120416110515]] 『マクロで2つのデータを比較』（きゃとら） >>BOT こちらでした (Bun) ---- 後、書き忘れましたが? >>B 列と D列が 空白でなく、○でもないとき（○以外の何かが入力されているとき） >→A列にあってC列にないもの、A列とC列両方にあるもの、C列にあってA列にないもの >の3パターンに分けたいんです。 と言う事なので、提示された表のB列、D列は何も書かれていませんが? 当然、A列、C列に在るデータ分 「○」以外のデータが入っている物としています (Bun) ---- Bun様ありがとうございます。 Bun様のコードでうまくいきました それでお尋ねしたいのですが、 Dim blnMatch() As Boolean で宣言されている「チェックするための変数」というのはどのように使うのでしょうか。 恥ずかしながら、変数の後に () が付いているものの使い方が分からないのです… For文を繰り返すぐらいの処理は自力でできるようになりたいと思うのですが、今回は自分のコードを何度見直しても分かりません… これからは自力で作成できるように、勉強しておきたいのでよろしくお願いします。 ※B列とD列には、見出しに○が入って、あとは空白の場合もありますし、値が入っているものもあります。 （全部空白の時もあります） (NAGI) ---- >Dim blnMatch() As Boolean > >で宣言されている「チェックするための変数」というのはどのように使うのでしょうか。 >恥ずかしながら、変数の後に () が付いているものの使い方が分からないのです… > >For文を繰り返すぐらいの処理は自力でできるようになりたいと思うのですが、今回は自分のコードを何度見直しても分かりません… クドク成って申し訳ありませんが?、少し前置きをして置きます NAGIさんの最初の質問で出されているコードに就いて説明して置きます このコードは逐次探索（リニアサーチ?）と言う方法で、コードが簡単で解りやすいと言う利点が有ります 反面、処理コストが非常に大きいと言う欠点も有ります 例としてこう言う場合を考えて見て下さいA列に100個のデータが有り、またC列にも100個のデータが有ります 其々の列のデータはランダムに有り、A列のデータは全てC列のデータとMatchします 其処で、A列から1個取り出して、C列のデータの先頭から比較して行きます この時、もし値がい一致してら、C列ループを抜けます、 次にまたA列から次の値を取り出しC列の先頭から比較し一致したら・・これをA列の値が無く成るまで繰り返します 詰まり、最初に質問されたコードの動きを同じですよね? 其処でこの時の比較回数を考えて見て下さい、 取り合えず全て一致するデータと考えれば、A列の値をC列先頭から常に見て行くとすれば、 C列の中で値が一致するのは平均で50回比較する事に成ります 詰まり全体を考えると、A列の値1に50回の比較が必要なら、A列に100の値が在るなら100*50=5000回の比較をしなければ一致したデータを見つける事が出来ません もし、A列、C列のデータで一致しない物が在るなら（一致しない物はループを最後まで回さなければ解らない） 比較回数はもっと増えます 詰まり、上記のコードを2回繰り返すと成れば10000回以上比較しなければ成ら無く成ります そこで、この比較回数を減らす事を考えます 上段のループのの比較回数はショウガナイとして、上段のループが回っている時にC列で一致した値に印を付けたらどう成るかを考えます 此処で、前に私が提案した「Public Sub Test_2()」を見て下さい 此処では、A列、C列の値が一致した特、D列に印として「1」を代入しています 此れで、上段のループが終了した後、今度C列を上から（D列を?）見て行きます この時、D列に「1」が入っている物は、前にA列、C列の値が一致しているので処理から除外します D列に何も入っていない物だけ処理を行います（C列だけ有る値） とすれば、ループの比較回数はC列のデータが100個なら100回で済みます 詰まり、上段のループの比較回数が5000回なら全ての比較回数は+100回で5100回で済みます 上下2段でループを回す場合の半分強で済みます ですが、「あと、他の列にもデータが入ってるので作業列は極力使いたくないです。」と言う事で却下されました 別にD列で無くても善いのでがね? 其処で、本題に入りますが? 今回のコードでは、「Public Sub Test_2()」でD列に印を入れていた物を 作業列を使わないために、配列変数をC列の行に対応する様に確保して其れに印を入れる様にしています この、配列変数がblnMatchで、C列の行に対応する為、配列変数として宣言しています ただ、配列変数を宣言する時点では配列の要素数が決定していませんので Dim blnMatch() As Boolean とblnMatchを動的な配列として使いますよと言う宣言を行っています この、配列の要素数は 'C列の最終行を取得 lngRowsC = .Cells(Rows.Count, 3).End(xlUp).Row と此処で、C列の最終行をlngRowsCに取得して解るので 次に 'Matchしたらチェックする変数を確保 ReDim blnMatch(3 To lngRowsC) で要素数を決定しています（3はC列の開始行、lngRowsCはC列の終了行） この後は、「Public Sub Test_2()」と同様でD列を見て行くのでは無く、配列変数blnMatchを上から 見て行って、Test_2()では「1」で無い物でしたが、今回はblnMatch(i)がFalseの物を探しています 尚、 If .Cells(i, 2).Value <> "" And .Cells(i, 2).Value <> "○" And .Cells(j, 4).Value <> "" And .Cells(j, 4).Value <> "○" Then に該当する物を、値が一致もしくは、片方にだけ有ると言う所に移しているのは、 このレスの先頭に書いた様に、逐次探索は非常にコストが大きい為、「Sub Sample2()」の位置では 比較回数が5000回なら5000回このコードも実行されます しかし、このコードの持つ意味は、この後の一致した場合、一致しなかった場合の処理をすのかどうかと言う事に係るだけですので 一致した場合、一致しなかった場合の処理の所に移して在ります また、一致しなかった場合は、一致しなかったのですからD列の値を見る必要は有りませんので 削って在ります >※B列とD列には、見出しに○が入って、あとは空白の場合もありますし、値が入っているものもあります。 >（全部空白の時もあります） 此れに就いては、例えば「見出し_2」に就いて、此れを見分ける何かが在れば上記の物に対応する事は可能だと思います 例えば、「比較A ○ 比較C ○」の様にB列、D列に見分ける印が在るとか? (Bun) ---- A列、C列のデータ最終行の下の行が必ずEmpty値（空白）なら、こんなのでも? Public Sub Sample_4() Dim i As Long Dim j As Long Dim lngRowsA As Long 'A列の最終行 Dim lngRowsC As Long 'C列の最終行 Dim blnMatch() As Boolean With Worksheets("Sheet1") 'A列の最終行を取得 lngRowsA = .Cells(Rows.Count, 1).End(xlUp).Row 'C列の最終行を取得 lngRowsC = .Cells(Rows.Count, 3).End(xlUp).Row 'Matchしたらチェックする変数を確保 ReDim blnMatch(3 To lngRowsC) 'A列のLisを上から見て行く For i = 3 To lngRowsA 'C列のListを上から見て行く For j = 3 To lngRowsC 'A列とE列の値の先頭2文字を比較する If .Cells(i, 1).Value = .Cells(j, 3).Value Then 'チェックが無いなら(★印の行はデータに重複が無いなら無くても善いかも?) If Not blnMatch Then '★ '比較値が同じならForを抜ける Exit For '★ End If End If Next j 'C列のループを途中抜けたなら(同一の値が在った時) If j <= lngRowsC Then 'A列の比較する値がEmptyで無いなら If Not IsEmpty(.Cells(i, 1).Value) Then 'B列に○印が無いなら If .Cells(i, 2).Value <> "○" Then '比較する行の下のB列に○印が無いなら If .Cells(i + 1, 2).Value <> "○" Then 'C列の比較する値がEmptyで無いなら If Not IsEmpty(.Cells(j, 3).Value) Then 'D列に○印が無いなら If .Cells(j, 4).Value <> "○" Then '比較する行の下のB列に○印が無いなら If .Cells(j + 1, 4).Value <> "○" Then 'Matchした時の処理を行う .Cells(i, 1).Interior.ColorIndex = 7 .Cells(j, 3).Interior.ColorIndex = 7 End If End If End If End If End If End If 'FlagにMatchした印を入れる blnMatch(j) = True 'C列のループを回り切ったなら(同一の値が無かった時) Else 'A列の比較する値がEmptyで無いなら If Not IsEmpty(.Cells(i, 1).Value) Then 'B列に○印が無いなら If .Cells(i, 2).Value <> "○" Then 'C列と比較する行の下のB列に○印が無いなら If .Cells(i + 1, 2).Value <> "○" Then 'A列にしか無い場合の処理 .Cells(i, 1).Interior.ColorIndex = 34 End If End If End If End If Next i '※上記ループでは検出できないC列にだけ在るレコードを処理 'C列のListを上から見て行く For i = 3 To lngRowsC 'チックFlagに付けた印が無いなら(Matchした物以外なら) If Not blnMatch(i) Then 'C列の比較する値がEmptyで無いなら If Not IsEmpty(.Cells(i, 3).Value) Then 'D列に○印が無いなら If .Cells(i, 4).Value <> "○" Then '比較する行の下のB列に○印が無いなら If .Cells(i + 1, 4).Value <> "○" Then '片方にしか無い場合の処理 .Cells(i, 3).Interior.ColorIndex = 35 End If End If End If End If Next i End With MsgBox "処理が完了しました", vbInformation End Sub 処理除外条件が複雑に成ってコードの見通しが悪く成るので 除外条件を別のFunctionプロシージャに分けるとこんなかな? Public Sub Sample_5() Dim i As Long Dim j As Long Dim lngRowsA As Long 'A列の最終行 Dim lngRowsC As Long 'C列の最終行 Dim blnMatch() As Boolean With Worksheets("Sheet1") 'A列の最終行を取得 lngRowsA = .Cells(Rows.Count, 1).End(xlUp).Row 'C列の最終行を取得 lngRowsC = .Cells(Rows.Count, 3).End(xlUp).Row 'Matchしたらチェックする変数を確保 ReDim blnMatch(3 To lngRowsC) 'A列のLisを上から見て行く For i = 3 To lngRowsA 'C列のListを上から見て行く For j = 3 To lngRowsC 'A列とE列の値の先頭2文字を比較する If .Cells(i, 1).Value = .Cells(j, 3).Value Then 'チェックが無いなら(★印の行はデータに重複が無いなら無くても善いかも?) If Not blnMatch Then '★ '比較値が同じならForを抜ける Exit For '★ End If End If Next j 'C列のループを途中抜けたなら(同一の値が在った時) If j <= lngRowsC Then 'A列、B列の除外データ確認 If DataCheck(.Cells(i, 1)) Then 'C列、D列の除外データ確認 If DataCheck(.Cells(j, 3)) Then 'Matchした時の処理を行う .Cells(i, 1).Interior.ColorIndex = 7 .Cells(j, 3).Interior.ColorIndex = 7 End If End If 'FlagにMatchした印を入れる blnMatch(j) = True 'C列のループを回り切ったなら(同一の値が無かった時) Else 'A列、B列の除外データ確認 If DataCheck(.Cells(i, 1)) Then 'A列にしか無い場合の処理 .Cells(i, 1).Interior.ColorIndex = 34 End If End If Next i '※上記ループでは検出できないC列にだけ在るレコードを処理 'C列のListを上から見て行く For i = 3 To lngRowsC 'チックFlagに付けた印が無いなら(Matchした物以外なら) If Not blnMatch(i) Then 'C列、D列の除外データ確認 If DataCheck(.Cells(i, 3)) Then '片方にしか無い場合の処理 .Cells(i, 3).Interior.ColorIndex = 35 End If End If Next i End With MsgBox "処理が完了しました", vbInformation End Sub Private Function DataCheck(rngMark As Range) As Boolean With rngMark '比較する値がEmptyで無いなら If Not IsEmpty(.Value) Then '隣の列に○印が無いなら If .Offset(, 1).Value <> "○" Then '比較する行の下の右下のセルに○印が無いなら If .Offset(1, 1).Value <> "○" Then '戻り値としてTrueを返す DataCheck = True End If End If End If End With End Function (Bun) ---- Bun様詳しいご説明ありがとうございます。 配列変数…聞いたことがなかったので検索して調べましたがまだ難しいです… （ちなみにマクロを扱い始めて数か月です） >例えば、「比較A ○ 比較C ○」の様にB列、D列に見分ける印が在るとか? 上については、「比較X」のセルの隣には「○」が入ってます（○が見出しのようなもの） データ行の最終行の下は一行空白があります。 コードをよく見てもう少し勉強します (NAGI) ---- > 配列変数…聞いたことがなかったので検索して調べましたがまだ難しいです… >（ちなみにマクロを扱い始めて数か月です） 配列変数て難しいと思ったら使えませんよ? ただの変数の塊で番号（要素番号）で呼び出したり、書き込んだり出来るだけですから >データ行の最終行の下は一行空白があります。 成らば、「Sample_4」も「Sample_5」も動くと思います (Bun)... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201204/20120417121849.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97039 documents and 608037 words.
訪問者：