特定フィールドから重複を削除した値を取得する

特定フィールドから重複を削除した値を取得する

DISTINCT指定の利用
SELECT DISTINCT フィールド FROM テーブル;

SELECT DISTINCT 商品ID FROM SQL注文;

重複を除いた値を返す関数を作成する

Function getUniqueData(myRng As Range) As Variant
Dim myCon As New ADODB.Connection, myRS As New ADODB.Recordset
Dim mySrc As String, mySQL As String, tmpStr As String

'呼び出し元ブックのパス
mySrc = myRng.Parent.Parent.Path & "\" & myRng.Parent.Parent.Name

'[シート名$セル範囲]の形で文字列指定
'myRng.Address(False, False)として、相対参照とする
'こうしないと [Sheet2$$E$1:$E$10] となってしまうので呼び出し元の範囲がおかしくなる
tmpStr = "[" & myRng.Parent.Name & "$" & myRng.Address(False, False) & "]"

'SQL
mySQL = "select distinct " & myRng.Cells(1).Value & " from " & tmpStr

'接続
With myCon
  .Provider = "Microsoft.Jet.OLEDB.4.0"
  .Properties("Extended Properties") = "Excel 8.0"
  .Open mySrc
End With

'SQLの結果を取得
myRS.Open mySQL, myCon

'取得したレコードセットを文字列に変換
tmpStr = Trim(myRS.GetString(adClipString, rowdelimeter:=" "))

'文字列を返す
getUniqueData = tmpStr

myRS.Close: Set myRS = Nothing
myCon.Close: Set myCon = Nothing

End Function

引数として渡したセル範囲の1行目をフィールド名としてその列に含まれる値から重複を取り除いた値を文字列の形で返す。

モジュールからメッセージボックスで呼び出す

Sub 重複を除いた値を取得()
MsgBox getUniqueData(Range("E1:E10"))
End Sub

モジュールのあるブックに関数貼り付け

別のブックに関数貼り付け