[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『For文を２つ繰り返したいのですが』（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
一応、サンプルです。
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）
下のコードを
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)
ですが、ステップ実行していかないということは、そのときの変数を見ればわかると
思うのですが、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)
ご自身で書かれているように、データ起因だと思いますが空白に見える部分にスペースが
あるというようなことはないでしょうか。
数式がある場合は 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文を２つ繰り返したいのですが』（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文を２つ繰り返したいのですが』（NAGI）
では無く
[[20120416110515]] 『マクロで２つのデータを比較』（きゃとら） >>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)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.