Excel VBA: カーソルのある行と同じデータを持つ行群にマーク？

質問

お世話になります。
以前、現在選択されているセルを含む行の特定の列にマークを打つという問題がありまして、こちらで回答をいただきました。
http://okwave.jp/qa4787458.html

さて、似た問題でまた詰まってしまいました。
「現在カーソルがある行の、ある列の値と、同じ列の値が同じ行のみ、別の列にマークを打つ」というものです。

５行５列のシートがあり、２列目が注目しているデータだとします。
マークは５列目に打ちたいです。
カーソル（アクティブセル）を▽であらわします。

（例題１）
＼ＡＢＣＤＥ
１□□米□□
２□□国□□
３▽□国□□
４□□国□□
５□□米□□

いま、Ａ３がアクティブセルです。
Ｃ２、Ｃ３、Ｃ５に「国」というデータがあります。
Ｃ列の他の行には違うデータ（「米」）があります。
カーソルのある３行目のＣ列の「国」に注目し、同じＣ列に「国」が入っている３つの行のＥ列にマーク（＊）を打ちます。
処理後はこうしたいです。

＼ＡＢＣＤＥ
１□□米□□
２□□国□＊
３▽□国□＊
４□□国□＊
５□□米□□

以下、処理前、処理後でやりたい処理を示します。

（例題２）
＼ＡＢＣＤＥ
１□□国▽□
２□□英□□
３□□国□□
４□□米□□
５□□国□□

＝＞

＼ＡＢＣＤＥ
１□□国▽＊
２□□英□□
３□□国□＊
４□□米□□
５□□国□＊

（例題３）
＼ＡＢＣＤＥ
１□□英□□
２□□国□□
３□□米□□
４□□国□□
５□□国▽□

＝＞

＼ＡＢＣＤＥ
１□□英□□
２□□国□＊
３□□米□□
４□□国□＊
５□□国▽＊

実際にはシートはもっと大きく、注目する列がＣ以外に２列あるパターンもあるのですが、さしあたり上の例について解決したいと思います。

最初は例によって１行１行見ていました。

Sub test()
Dim myRow as long
Dim myCol as long
For myRow = 1 to 65536
For myCol = 1 to 3
If Cells(myRow, myCol).Value = "国" Then
Cells(myRow, 5).Value = "＊"
Exit For
End If
Next myCol
Next myRow
End Sub

しかしこれだとシートが広いので遅くなります。
あるキーを押すと処理が走って、処理中はずっとオペレーターが待っているというフローなので、一瞬でも早くしたいところです。

次に、オートフィルターを使って３列目に「国」がある行を表示にし、上の回答で教えていただいた Intersect 関数を使ってうまくいったのですが、処理前にすでにオペレーターがフィルター設定している場合があり、そのフィルター設定が壊れると作業に支障があるのであきらめました。

処理前のオートフィルターを記憶して、処理後に復元するというのもやってみたのですが、プログラムが複雑になるので避けたい感じです。

なお、Excel 2007 と書きましたが、オペレーターによっては Excel 2003 を使い続けている人がいることが最近判明しました。
今は Excel 2003 形式の XLS にマクロをアタッチして XLSTART に入れさせています。
FileSearch のような 2007 で廃止された機能を使わない限り、2003 のマクロは 2007 で動くようです。

以上です。
よろしくお願いします。

回答No.2

n-jun · ベストアンサー

＃１です。

オートフィルタが楽そうですが、提示されているコードで気になったのが、
・最終行（６５５３６）まで確認が必要か
・Ａ～Ｃ列のうち１個でも”国”があればいいのでは
と言う点で作成したコードです。

Sub try()
Dim r As Range
Dim rr As Range

Set r = ActiveSheet.UsedRange

For Each rr In Range("A1", Range("A" & r.Item(r.Cells.Count).Row))

If Application.CountIf(rr.Resize(, 3), "国") > 0 Then
rr.Offset(, 4).Value = "*"
End If

Next

Set r = Nothing
End Sub

どうでしょうか？

お礼

ありがとうございます！
緊急対応が入ってしまったので、すぐに試せませんが、必ずお返事します。

私の目的では、

＞・最終行（６５５３６）まで確認が必要か
は、上記のコードのように使っている範囲で大丈夫です。
（実際には見出しを飛ばして２行目から）

＞・Ａ～Ｃ列のうち１個でも”国”があればいいのでは
は、「国」が出てくるのはＣ列に決まっています。
ただし、別の条件（Ｄ列が「kg」とか）が場合によって発生する可能性があります。

いただいたコードをよく研究します。
本当にありがとうございます！

補足

お世話になります。
いただいたコードを元に作成できました。
あまり速度が落ちず、満足しています。
今後も何かありましたらお願いします。

回答No.4

hige_082

質問をコードにすると、こうなると思うのですが？

Sub test()
Dim myRow As Long
Dim key As Variant
Dim cCol As Variant

key = Cells(ActiveCell.Row, 3).Value
cCol = Range("c1", Cells(65536, 3).End(xlUp).Offset(0, 2))

For myRow = 1 To UBound(cCol, 1)
If cCol(myRow, 1) = key Then
cCol(myRow, 3) = "＊"
End If
Next myRow
Range("c1", Cells(65536, 3).End(xlUp).Offset(0, 2)) = cCol
End Sub

参考までに

お礼

繰り返しになりますが、今回ご相談の方法があまりよくなくて、いろいろひねくっているうちに、結果的にhige_082さんのようなコードになりました (^^;;;
本当にありがとうございます。
今後もよろしくお願いします。

回答No.3

DOUGLAS_

＃ちょっと変わった方法をお一つ。。。

＞現在カーソルがある行の、ある列の値と、
＞同じ列の値が同じ行のみ、別の列にマークを打つ
とのことで、例示されているＶＢＡでは、「国」をキーワードにしていらっしゃいますが、実際は
Cells(myRow, myCOl).Value = Cells(ActiveCell.Row, myCOl)
ですよね。

シートモジュールに

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　ActiveWorkbook.Names.Add Name:="AC", RefersToR1C1:="=ACTIVE.CELL()"
　Range("E2:E" & Range("A1").End(xlDown).Row).FormulaR1C1 _
　= "=IF(RC[-2]=INDIRECT(""C"" & ROW(AC)),""*"","""")"
End Sub

でいかがでしょうか？

＞シートが広いので遅くなります。
　１００００行ほどデータを入れて確認してみましたが、私の低スペックのパソコンでも、一瞬で処理できました。

お礼

ありがとうございます。
このようなページでプログラムの相談をする場合は、業務の守秘義務もありますし、大量のコードを読ませて回答を下さる方を煩わせるわけにもいきませんので、状況を単純化させるわけですが、今回は単純化の仕方があまりよくなかったようです。
具体的に言うと、最初に書いた問題とコードが合っていませんでした。

シートモジュールにイベントを書く、というのは面白い方法ですね。
書いていないことがあって、この方法は今回適用しませんが、覚えておいていつか使おうと思います。
本当にありがとうございました。

回答No.1

n-jun

＞処理前にすでにオペレーターがフィルター設定している場合があり、
＞そのフィルター設定が壊れると作業に支障があるのであきらめました。
まず今回の処理と上記の処理について、連動させないような配慮をするか、
重複してオートフィルタを使用しなくて済む処理手順にするかの、作業の見直しを
行なってから考えた方が宜しいのではないかと感じました。

お礼

ご回答ありがとうございます！
つまり、私が質問した処理を行うためには、マクロでオートフィルターを使って Intersect という現状の仕様がよいというお考えでしょうか。
フィルター処理とマーク処理はまったく任意のタイミングで発生し、ユーザーを制約するのは非常に難しいケースです。。。