みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

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

解決済みの質問

重複した値を一つ残す VBA

重複した値を一つだけ残していきたいです。
たとえば リンゴ リンゴ リンゴ とあれば2つリンゴが消えて欲しいです
今のところ重複した値を消す方法しかわからず詰まっています。
なにとぞよろしくおねがいします 

Option Explicit

Sub test()
Dim i As Double
Dim x As Double
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


Range("T3", Range("T" & Rows.Count).End(xlUp)).Sort Key1:=Range("T3"), Order1:=xlAscending, Header:=xlYes
For i = 3 To Cells(Rows.Count, 20).End(xlUp).Row
Range(Cells(i, "T"), Cells(i, "T")).RemoveDuplicates Columns:=Array(1), Header:=xlYes
Application.Calculate
Next
End Sub

投稿日時 - 2016-07-08 16:28:38

QNo.9198847

すぐに回答ほしいです

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

ここに質問をする前に、自分でいろいろ考えて、手段(ロジック)を考えること。
その後VBAコードでどう実現するか、自分のVBAの経験に照らしてやる。そのコードが判からなければ、したいロジックを文章で書いて質問するようにすべきだ。
===
下記は
「ある行の1セルの値が、その列全体の中に、2件以上あれば1件分だけ書き出す」というロジックでやってみた。これならだれでも思いつくだろう。
まずA列でソートー>コードは略
その次に
Sub test01()
i = 2
j = 2
lr = Worksheets("Sheet1").Range("A10000").End(xlUp).Row
MsgBox lr
p1:
x = Worksheets("Sheet1").Cells(i, "A")
c = WorksheetFunction.CountIf(Worksheets("Sheet1").Range("A2:A" & lr), x)
MsgBox c
If c >= 2 Then
Worksheets("Sheet2").Cells(j, "A") = x
j = j + 1
i = i + c
Else
i = i + 1
End If
If i > lr Then Exit Sub
GoTo p1
End Sub
ーーー
例データ Sheet1のA1:A15
項目
a
a
b
c
d
d
d
f
g
q
q
s
s
v
ーー
結果 Sheet2のA1以下に
a
d
q
s

投稿日時 - 2016-07-08 21:44:32

ANo.2

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

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

回答(2)

ANo.1

こんにちは
http://okwave.jp/qa/q9198825.html
に回答したコードではダメなのですか?

Sub test()
  Range("T3", Range("T" & Rows.Count).End(xlUp)).Sort _
  Key1:=Range("T3"), Order1:=xlAscending, Header:=xlYes
  Range("T3", Range("T" & Rows.Count).End(xlUp)).RemoveDuplicates _
  Columns:=1, Header:=xlYes
End Sub

投稿日時 - 2016-07-08 16:41:17

あなたにオススメの質問