こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル 同じ内容行削除マクロ 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

解決策教えて下さい。

投稿日時 - 2008-10-10 20:47:01

QNo.4392139

すぐに回答ほしいです

質問者が選んだベストアンサー

こんばんは。

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

.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 21:28:08

お礼

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

投稿日時 - 2008-10-10 22:28:45

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.5

ANo.1です。

回答の際に省略してしまって混乱しちゃいましたね。
#3(Wendy02さん)の補足事項そのままです。

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

投稿日時 - 2008-10-10 22:15:03

ANo.4

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)

完全一致の検索

投稿日時 - 2008-10-10 21:29:09

ANo.2

前回の御質問に回答したコードですが、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

投稿日時 - 2008-10-10 21:07:25

ANo.1

Findメソッドでのデータ検索
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_find.html
【例1】完全一致
の欄を参考にされては。

投稿日時 - 2008-10-10 20:52:36

補足

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

投稿日時 - 2008-10-10 21:07:43

あなたにオススメの質問