8000件のリストを別シートから検索するマクロ

質問

自分なりにFindメソッド等考えてみたのですが、上手くいかなくて…
どなたか教えて頂けると助かりますm(__)m
シートAに8000件の会社名があり、上から順番にシートB全体(シートAの会社名が平仮名、片仮名、漢字、英語が混在しているので。。。シートBの名称、ふりがな、漢字名称の全てで検索をかけたいんです)から検索して、ヒットしたら会社名の横のセルに1を立てたいのです!そんなマクロありますか？
業務で一日中、手動で検索をかけるのは。。。だいぶツライので；
よろしくお願いします。

回答No.4

mt2008

その検索を1度しかしないのであれば多少処理が遅くてもセル関数でやってしまう方が面倒が無くて良さそうに思えます。
シートAのA列に会社名が縦に入っていると仮定して、
B1に↓を入れて下方向へオートフィルしてください。
=COUNTIF(シートB!$1:$65536,A1)

0/1ではなく、シートBに存在した数が表示されます。

回答No.3

n-jun

＃１です。

ようは”あるか・ないか”でいいんですよね？
そうならば、IF関数とCOUNTIF関数でやるのではまずいのでしょうか？

ただ検索値が複数行＆複数列であるなら無理ですけど・・・

回答No.2

merlionXX

ご提示の情報が少なすぎるのでこちらで仮定しました。
シートA⇒Sheet1とします。
シートB⇒Sheet2とします。
シートAに8000件の会社名⇒Sheet1のA1からA8000までに縦一列に入力されているものとします。
シートBの名称、ふりがな、漢字名称の全てで検索をかけたい⇒Sheet1のA1からA8000までに記入された文字列でSheet2全体を検索するという意味ですね？
横のセルに1⇒Sheet1のA1からA8000までの中でヒットしたデータの隣のセルとします。

Sub TEST01()
Dim r As Range, c As Range, i As Long
With Sheets("Sheet1") 'Sheet1で
For Each r In .Range("A1:A8000") 'A1:A8000の各セルにつき
If r <> "" Then '空白でなければ
Set c = Sheets("Sheet2").Cells.Find(What:=r.Value, LookAt:=xlWhole) 'Sheet2を完全一致検索
If Not c Is Nothing Then 'あったら
r.Offset(0, 1).Value = 1 'Sheet1の指定セルの隣に１を入力
i = i + 1 'カウント
End If
End If
Next r '次のセルで繰り返す
End With
Set c = Nothing
MsgBox i & "件を発見しました。", vbInformation, " （￣ー￣）v"
End Sub

回答No.1

n-jun

＞自分なりにFindメソッド等考えてみたのですが、上手くいかなくて…
まずこのコードを提示してみては？

＞ヒットしたら会社名の横のセルに1を立てたいのです！
どちらのシートに？
具体的なシート構成を提示された方が良いかも。