Excel(エクセル) VBA入門：重複なしのデータを抽出するいろいろな方法

• 1列に重複したデータがあり、重複なしのデータを取り出す各種方法を書いてみます。

テストデータ　　　Topへ

• このページの各コードはSheet1のA列に重複したデータがあり、Sheet2へ各種方法で重複なしのデータとして抽出します。
• ここでは、処理速度が遅いものから順に書いています。
  • 単純なループ、配列によるループ、フィルタオプションの設定、Dictionaryの利用の例、といった順です。
    データ量が多くなると処理時間を早くしたくなります。そういう時はDictionaryの利用がお勧めです。
• サンプルデータ
  

  Sheet1の元データの例	Sheet2へ抽出した例

For〜Nextで逐次チェックする方法　　　Topへ

• もっとも基本的な方法で重複しているか否かを逐次調べ重複がなかったらSheet2へ追加していきます。
  ここで書いている方法の中では最も時間がかかります。
  • コード例
    

    Sub ループ() 　Dim lastRow1 As Long, lastRow2 As Long 　Dim i As Long, j As Long, myCnt As Long 　　　　With Worksheets("Sheet2") 　　　　　　.Range("A:A").ClearContents 　　　　　　.Range("A1") = Worksheets("Sheet1").Range("A1").Value 　　　　　　lastRow1 = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row 　　　　　　For i = 2 To lastRow1 　　　　　　　　myCnt = 0 　　　　　　　　lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row 　　　　　　　　For j = 1 To lastRow2 　　　　　　　　　　If .Cells(j, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value Then 　　　　　　　　　　　　Exit For 　　　　　　　　　　Else 　　　　　　　　　　　　myCnt = myCnt + 1 　　　　　　　　　　End If 　　　　　　　　Next j 　　　　　　　　If myCnt = lastRow2 Then 　　　　　　　　　　.Cells(lastRow2 + 1, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value 　　　　　　　　End If 　　　　　　Next i 　　　　End With End Sub

データを配列に読み込んでFor〜Nextで逐次チェックする方法　　　Topへ

• 元のデータを配列(x)に読み込み、For〜Nextで逐次チェックします。
  配列でチェックしているため上の方法よりは短時間で処理できます。
  • コード例
    

    Sub 配列() 　　Dim x, y 　　Dim myCnt As Long, myFlg As Boolean 　　Dim i As Long, j As Long 　　　　With Worksheets("Sheet1") 　　　　　　x = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) 　　　　End　With 　　　　ReDim y(1 To UBound(x), 1 To 1) 　　　　y(1, 1) = x(1, 1) 　　　　myCnt = 1 　　　　For i = LBound(x) To UBound(x) 　　　　　　myFlg = False 　　　　　　For j = 1 To myCnt 　　　　　　　　If x(i, 1) = y(j, 1) Then myFlg = True: Exit For 　　　　　　Next j 　　　　　　If myFlg = False Then myCnt = myCnt + 1: y(myCnt, 1) = x(i, 1) 　　　　Next i 　　　　With　Worksheets("Sheet2"). 　　　　　　Range("C:C").ClearContents 　　　　　　.Range("C1").Resize(UBound(y), 1) = y 　　　　End With End Sub

フィルタオプションの設定を利用する　　　Topへ

• Excelの一般機能であるフィルタオプションの設定を利用します。
  フィルタオプションの設定では列見出しが必要ですので、仮の見出しを挿入して抽出後に削除しています。
  配列の方法より短時間で処理できます。
  • コード例
    

    Sub myAd() 　　Dim rngData As Range, rngC As Range 　　With Worksheets("Sheet1") 　　　　.Range("A1").Insert xlDown 　　　　.Range("A1").Value = "見出し" 　　　　Set rngData = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp)) 　　　　Set rngC = Worksheets("Sheet2").Range("E1") 　　　　rngData.AdvancedFilter _ 　　　　　　Action:=xlFilterCopy, _ 　　　　　　CopyToRange:=rngC, _ 　　　　　　Unique:=True 　　　　.Range("A1").Delete xlUp 　　End With 　　With Worksheets("Sheet2") 　　　　.Range("E:E").ClearContents 　　　　.Range("E1").Delete xlUp 　　End With End Sub

Dictionaryを利用する　　　Topへ

• Dictionaryオブジェクトを利用します。
  このページの中ではもっとも短時間で処理できます。
  • コード例
    

    Sub myDic() 　　Dim myDic As Object, myKey As Variant 　　Dim c As Variant, varData As Variant 　　　　Set myDic = CreateObject("Scripting.Dictionary") 　　　　With Worksheets("Sheet1") 　　　　　　varData = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value 　　　　End With 　　　　For Each c In varData 　　　　　　If Not c = Empty Then 　　　　　　　　If Not myDic.Exists(c) Then 　　　　　　　　　　myDic.Add c, Null 　　　　　　　　End If 　　　　　　End If 　　　　Next 　　　　myKey = myDic.Keys 　　　　With Worksheets("Sheet2") 　　　　　　.Range("G:G").ClearContents 　　　　　　.Range("G1").Resize(myDic.Count) = Application.WorksheetFunction.Transpose(myKey) 　　　　End With 　　　　Set myDic = Nothing End Sub

PageViewCounter
　
　Since2006/2/27