- ベストアンサー
VBAでデータの重複を除いて取り出す方法
- VBAを使用して、エクセルのデータから重複を除いて取り出す方法について教えてください。
- 配列を使用してデータを取り出す方法についても教えていただきたいです。
- 他の方法でもデータの重複を除いて取り出す方法を教えていただきたいです。
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 最初に、これは関数でも可能なような気がします。 Excel VBAだったら、こんな方法を発想すると思います。タイトル行がないのが面倒にはさせますが。最初のコードは、Excelのあるバージョンの一部のリビジョンでは、確率は低いのですが、全部、コピーされてしまう不具合があるそうです。その場合は、SpecialCells で対処する場合があります。 '------------------------------------------- Sub UniquePickUP() Application.ScreenUpdating = False With ActiveSheet .Range("A1").EntireRow.Insert Shift:=xlDown .Range("A1").Resize(, 2).Value = Array("A", "B") '2列のみ .Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterInPlace, _ Unique:=True With .Range("A1").CurrentRegion .Offset(1).Resize(.Rows.Count - 1).Copy Worksheets("Sheet2").Range("A1") End With .ShowAllData .Range("A1").EntireRow.Delete End With Application.ScreenUpdating = True Worksheets("Sheet2").Select End Sub '------------------------------------------- ご質問の要件ですと、配列に割り当てるなら、こうなるのでしょうか? ちょっと難しいですね。 Sub ArraySplits() Dim rng As Range Dim c As Range Dim Ar() As Variant Dim Ar1() As Variant Dim i As Long Dim ret As Variant Dim buf As Variant With ActiveSheet Set rng = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)) For Each c In rng buf = c.Value & "," & c.Offset(, 1).Value If i > 0 Then ret = Application.Match(buf, Ar(), 0) End If If IsError(ret) Or i = 0 Then ReDim Preserve Ar(i) Ar(i) = buf i = i + 1 End If Next Set rng = Nothing End With ReDim Ar1(UBound(Ar), 1) For i = LBound(Ar) To UBound(Ar) Ar1(i, 0) = Split(Ar(i), ",")(0) Ar1(i, 1) = Split(Ar(i), ",")(1) Next i Worksheets("Sheet2").Range("A1").Resize(UBound(Ar1) + 1, 2).Value = Ar1 Worksheets("Sheet2").Select End Sub
その他の回答 (2)
- SAKENOSAKA
- ベストアンサー率32% (78/240)
簡単な方法は ソートされたデータでやることです。 それなら単純比較で抽出できるでしょ。
- SaKaKashi
- ベストアンサー率24% (755/3136)
VBAでする必要があるのですか? 列を選んで、フィルタ->詳細設定で重複するレコードは無視する をチェックしてみてください。
お礼
どうもありがとうございました。 インターネットで検索したら、重複のしないようにソートする方法が見つかりました。 有名な方法がありました。