VBA 重複削除 – テックメモ

重複を取り除く方法はいくつかあると思うけど、ネット上で一番有名なdictionaryを使う方法を採用。

Sub DeleteDuplicate()

Set dic = CreateObject("scripting.dictionary")

For Each r In Selection
  If Not dic.exists(r.Value) Then dic.Add r.Value, ""
Next

k = dic.keys
For i = 0 To dic.Count - 1
  Sheets("Sheet2").Cells(i + 1, 1).Value = k(i)
Next i

End Sub

Sub DeleteDuplicate()

Set dic = CreateObject("scripting.dictionary")

For Each r In Selection

If Not dic.exists(r.Value) Then dic.Add r.Value, ""

k = dic.keys

For i = 0 To dic.Count - 1

Sheets("Sheet2").Cells(i + 1, 1).Value = k(i)

Next i

End Sub

少し違うバージョン

Sub DeleteDuplicate()
 
Set dic = CreateObject("scripting.dictionary")

Set w = ActiveSheet

For r = 2 To 4111

  k = w.Cells(r, 1).Value
  v = w.Cells(r, 2).Value

  If Not dic.exists(k) Then dic.Add k, v
  
Next

kk = dic.keys
vv = dic.items

For i = 0 To dic.Count - 1
  w.Cells(i + 1, 4).Value = kk(i)
  w.Cells(i + 1, 5).Value = vv(i)
Next i
 
End Sub

Sub DeleteDuplicate()

Set dic = CreateObject("scripting.dictionary")

Set w = ActiveSheet

For r = 2 To 4111

k = w.Cells(r, 1).Value

v = w.Cells(r, 2).Value

If Not dic.exists(k) Then dic.Add k, v

kk = dic.keys

vv = dic.items

For i = 0 To dic.Count - 1

w.Cells(i + 1, 4).Value = kk(i)

w.Cells(i + 1, 5).Value = vv(i)

Next i

End Sub