同列で重複する文字をひとつとし別セルに順に表示

質問

VBAコードを用い画像のようにA列で重複する文字は無視し違う文字のみ順に別セルに表示したいのですがどなたか解る方宜しくお願いします。

回答No.1

imogasi · ベストアンサー

上の行から順次下で繰り返し判別する。それは
「現在のセルの値」が、「Ａ２から現在行までにおいて」ＣＯＵＮＹＩＦで数を出し、１の場合はＣ列に持って行き、２以上なら持っていかないようにすれば仕舞。
最近これと同系統の質問が続くが、これがいちばんやさしい。
関数だけでも答えを挙げる人もいるだろう。
Sub test01()
lr = Range("A100000").End(xlUp).Row
j = 2
For i = 2 To lr
x = WorksheetFunction.CountIf(Range("A1:A" & i), Cells(i, "A"))
If x = 1 Then
Cells(j, "C") = Cells(i, "A")
j = j + 1
Else
End If
Next i
End Sub

お礼

ありがとうございます。非常に助かりました。

回答No.3

imogasi

#1です。もう１つ。
Sub test01()
'A1 以下にデータがあること。
'Sheet2があること。
'データのあるシートがアクチブなっていること
Range("A1").CurrentRegion.Select
Selection.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet2").Range("A1"), Unique:=True
End Sub
データのあるシートと同シートのＦ列に出すなら
Sub test01()
'Ｓｈｅｅｔ１のA1 以下にデータがあること。
'データのあるシートＳｈｅｅｔ１がアクチブなっていること
Range("A1").CurrentRegion.Select
Selection.AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Sheets("Sheet1").Range("F1"), Unique:=True
End Sub
Unique:=True　　がポイント
元データの順序は、結果にも保存されるようだ。

お礼

ありがとうございます。

回答No.2

ushi2015

こんにちは
Excelのバージョンにもよりますが、A列をコピーしてC列に貼り付けて
データタブの重複の削除を行う作業をマクロに記録してコードを整理する
だけでも良いと思います。
Sub Macro1()
'
' Macro1 Macro
'

'
　　Range("A1").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　　Range("C1").Select
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
　　ActiveSheet.Range("$C$1:$C$12").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
を下記のように整理します。
Sub test()
　　Range("A1", Range("A1").End(xlDown)).Copy Range("C1")
　　Range("$C:$C").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub

お礼

ありがとうございます。