dポイントプレゼントキャンペーン実施中!

Excel2007からは重複したデータを消すことは出来ますが、同じ文字列を全部消す(ひとつものこらず)方法が無いか悩んでいます。
例えば、A1に「1234」 A2に「4231」 A3に「1234」がある場合、A1とA3どちらも削除したいです。
このような事が自動で出来るマクロをどのようにすれば作れるでしょうか?
私が考えているのは、

1)A列をソート
2)一つ前の行と比較して同じならどちらの行も消す (同じデータは、2つ以上ないです)

という具合なのですが、2の部分の書き方が分かりません。

A 回答 (2件)

いちいちループとかまわしません。


sub macro1()
 range("1:1").insert
 range("B:B").insert
 range("B1") = "head"
 range("B2:B" & range("A65536").end(xlup).row).formula = "=COUNTIF(A:A,A2)"
 range("A:B").autofilter field:=2, criteria1:=">1"
 activesheet.autofilter.range.delete shift:=xlshiftup
end sub


あなたのやりたいようにしたいなら。
sub macro2()
 dim i as long
 range("A:A").sort key1:=range("A1"), order1:=xlascending, header:=xlno
 for i = range("A65536").end(xlup).row to 2 step -1
  if cells(i, "A") = cells(i - 1, "A") then
   range(cells(i - 1, "A"), cells(i, "A")).delete shift:=xlshiftup
  end if
 next i
end sub
    • good
    • 0
この回答へのお礼

解法を教えていただいて、すごくよくわかりました。
B列に同じ数字をカウントする式を入れてそれをフィルタで抽出、削除する、という方法ですね。
明快なご回答ありがとうございました。

お礼日時:2012/02/17 04:51

一例です。


同一行を抽出後、行削除しています。

Sub sample()
Dim wk()
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Application.CountIf(Range("A:A"), Cells(i, 1)) > 1 Then
ReDim Preserve wk(n)
wk(n) = Cells(i, 1).Row
n = n + 1
End If
Next
For i = 0 To UBound(wk)
Rows(wk(i)).Delete
Next
Application.ScreenUpdating = True
End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!