Home Excel（エクセル）マクロ・VBA

3月 13, 2010

初期状態では「開発」リボンは表示されていません。
マクロの自動記録やフォームコントロールを使いたい時など困ってしまいます。
Officeボタン→[Excelのオプション]を実行します。

[基本設定]で「[開発]タブをリボンに表示する」にチェックを入れます。

[開発]タブが表示されました。

重複なしのデータ抽出（４）｜エクセルＶＢＡ

Excel（エクセル）マクロ・VBA

3月 13, 2010

0 6522

Dictionaryを利用する

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

重複なしのデータ抽出（３）｜エクセルＶＢＡ

Excel（エクセル）マクロ・VBA

3月 13, 2010

0 5951

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

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

重複なしのデータ抽出（２）｜エクセルＶＢＡ

Excel（エクセル）マクロ・VBA

3月 13, 2010

0 5543

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

元のデータを配列(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

重複なしのデータ抽出（１）｜エクセルＶＢＡ

Excel（エクセル）マクロ・VBA

3月 13, 2010

0 4881

For～Nextで逐次チェックする方法

もっとも基本的な方法で重複しているか否かを逐次調べ重複がなかったら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