エクセル 同じ内容行削除マクロ 2

シート1、シート2（基準）のB列を比較して同じ内容行を削除したいのですが、「栃木県3」と「＃栃木県3」を同じのもと考えて削除されてしまいます。

Sub 削除()
　　Dim wh1　　　　 As Worksheet
　　Dim wh2　　　　 As Worksheet
　　Dim f　　　　　 As Range
　　Dim wR　　　　　As Integer
　　Dim mR　　　　　As Long
　　Dim wStr　　　　As String
　　'
　　Set wh1 = Worksheets("Sheet1")
　　Set wh2 = Worksheets("Sheet2")
　　wR = 0
　　With wh1
　　　　mR = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　For wR = mR To 1 Step -1
　　　　　　wStr = .Cells(wR, "B")
　　　　　　Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr)
　　　　　　If Not f Is Nothing Then
　　　　　　　　.Rows(wR).Delete
　　　　　　End If
　　　　Next
　　End With
End Sub

解決策教えて下さい。

No.3 ベストアンサー 回答者： Wendy02 回答日時： 2008/10/10 21:28

こんばんは。

書いた回答者には悪いけれども、

.Find(wStr)

これは、Find ステートメントの細かな設定が書いていないので、ワークシート側の検索などで使った設定そのものが残ってしまっています。だから、本来は、設定を必ず書いてあげなくてはなりません。#1 さんのご指摘は、その部分を参考にしてください、という意味です。

ただ、元のマクロは、難しく書きすぎのように思います。
Find メソッド自体は、オブジェクトを戻り値にしますから、オーバーヘッドがわずかに生じてしまいますから、以下のように、ワークシート関数で代用が利きます。ただ、このような単純なものに限ります。
もちろん、CountIf の第二引数は、& "*" （ワイルドカード）も可能です。


Sub 削除2()
　　Dim rng　 As Range
　　Dim i　　 As Long
　　Dim j　　 As Long
　　Dim ret As Variant
　　
　　With Worksheets("Sheet2")
　　　　Set rng = .Range("B1", .Range("B" & Rows.Count).End(xlUp))
　　End With
　　
　　With Worksheets("Sheet1")
　　　　For i = .Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
　　　　　　ret = WorksheetFunction.CountIf(rng, .Cells(i, 2))
　　　　　　If ret > 0 Then
　　　　　　　　.Rows(i).Delete
　　　　　　End If
　　　　Next
　　End With
　　Set rng = Nothing
End Sub
　　
　　

この回答へのお礼

ご丁寧な解説有難う御座いました。
解決です。

お礼日時：2008/10/10 22:28

No.5 回答者： n-jun 回答日時： 2008/10/10 22:15

ANo.1です。

回答の際に省略してしまって混乱しちゃいましたね。
＃３（Wendy02さん）の補足事項そのままです。

エクセル 同じ内容行削除マクロ
http://okwave.jp/qa4386962.html
私も諸先輩の方の回答からFindメソッドを使用する際には、省略は意図しない動きをする旨をご指導受けましたので、
Dictionaryオブジェクトを用いました。

No.4 回答者： okormazd 回答日時： 2008/10/10 21:29

Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr)

↓
Set f = wh2.Range("B1:B" & wh2.Cells(Rows.Count, "B").End(xlUp).Row).Find(wStr, lookat:=xlWhole)

完全一致の検索

No.2 回答者： mitarashi 回答日時： 2008/10/10 21:07

前回の御質問に回答したコードですが、xlWholeを指定しているので、こちらなら大丈夫だと思います。

Sub test()
Dim myCell As Range, whatRange As Range, targetRange As Range
Dim rtnRange As Range, hitRange As Range

Set whatRange = Sheets("Sheet2").Range(Sheets("Sheet2").Range("B1"), Sheets("Sheet2").Range("B1").End(xlDown))
Set targetRange = Sheets("Sheet1").UsedRange.Columns("b")
For Each myCell In whatRange
Set rtnRange = findRange(targetRange, myCell.Value, xlWhole)
If Not rtnRange Is Nothing Then
If hitRange Is Nothing Then
Set hitRange = rtnRange
Else
Set hitRange = Union(hitRange, rtnRange)
End If
End If
Next myCell
If Not hitRange Is Nothing Then hitRange.EntireRow.Delete
End Sub

Private Function findRange(targetRange As Range, matchString As String, matchMode As Long) As Range
Dim c As Range
Dim firstAddress As String

With targetRange
Set c = .Find(matchString, LookIn:=xlValues, lookAt:=matchMode)
Set findRange = c
If Not c Is Nothing Then
firstAddress = c.Address
Do
Set c = .FindNext(c)
If Not c Is Nothing Then Set findRange = Union(findRange, c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Function

No.1 回答者： n-jun 回答日時： 2008/10/10 20:52

Findメソッドでのデータ検索

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/v …
【例1】完全一致
の欄を参考にされては。

この回答への補足

拝見させて頂きました。
mykeyの所にシート2の項目を全て書き込まないといけないのでしょうか？

補足日時：2008/10/10 21:07