Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　SQL文を使って重複しない行を取得する
'
'  Copyright(C) 2000 Sunago
'
'　　名前定義したセル範囲(Sheet1のTable1)からタイトル名Idが
'  重複しない行をSQL文を使って取得します。データを取得する
'　セル範囲には見出し行を用意します(SQLで項目となります）。
'
'　　このマクロを実行するには、参照可能なライブラリファイルとして
'  Microsoft ActiveX Data Objects 2.1 Library(ADO)または同等
'  ライブラリへの参照設定が必要です。
'
Option Explicit

'/* SQL文を使って重複しない行を取得する(ADO利用) */
'
Sub Macro1()
Dim Cnn As ADODB.Connection
Dim Rec As ADODB.Recordset
Dim strConn As String
Dim strSQL As String

    'バージョンチェック
    If Ver9Check = False Then
        MsgBox "このバージョンのEXCELでは別途ADOライブラリを入手し、" & vbCr & _
                "インストールする必要があります。"
        Exit Sub
    End If
    
    Set Cnn = New ADODB.Connection
    Set Rec = New ADODB.Recordset
    
    strConn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "User ID=Admin;Password=;" & _
                    "Data Source=" & ThisWorkbook.FullName & ";" & _
                    "Extended Properties=Excel 8.0;"        ' Excel8.0(97)/9.0(2000)

    Cnn.Open strConn
    With Rec
        Set .ActiveConnection = Cnn
        '項目Idのデータが重複しない行を取得する
        '※重複判定しない列は最小値データを取得する
        Worksheets("結果１").Cells.Clear
        strSQL = "SELECT DISTINCT Id, MIN(Name) AS Name FROM Table1 GROUP BY Id"
        .Open strSQL, , , , adCmdText
        Worksheets("結果１").Range("A1").CopyFromRecordset Rec
        .Close
        '※重複判定しない列は先頭データを取得する
        Worksheets("結果２").Cells.Clear
        strSQL = "SELECT DISTINCT Id, First(Name) AS Name FROM Table1 GROUP BY Id"
        .Open strSQL, , , , adCmdText
        Worksheets("結果２").Range("A1").CopyFromRecordset Rec
        .Close
    End With
    Cnn.Close
    
    Set Rec = Nothing
    Set Cnn = Nothing

End Sub

Private Function Ver9Check() As Boolean
Dim strver As String
    
    strver = Application.Version
    If Int(Left(strver, InStr(strver, "."))) < 9 Then
        Ver9Check = False
    Else
        Ver9Check = True
    End If

End Function