EXCELで検索で一致したキーの値を文字列連結する方法を教えてください。

VBAを使えば簡単にできそうですね。

VBAとはなんぞやという場合はこちらを参考にして標準モジュールにコピペして実行してみてください。

http://www.officepro.jp/excelvba/ini/index1.html

http://www.officepro.jp/excelvba/ini/index2.html

http://www.officepro.jp/excelvba/ini/index3.html

表ではＩＤは連番のようですけど、連番じゃない場合も考慮しています。

Sub Macro()
    Dim lastRow As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim j As Long
    Dim obj As Object
    
    With Worksheets("Sheet2")
        .Cells.Clear
        .Range("A1").Value = "ID"
        .Range("B1").Value = "趣味"
        
        lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        
        For i = 2 To lastRow
            Set obj = .Range("A:A").Find(what:=Worksheets("Sheet1").Cells(i, 1).Value, _
                LookAt:=xlWhole, MatchCase:=True, MatchByte:=True)
            If obj Is Nothing Then
                lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
                .Cells(lastRow2 + 1, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value
                .Cells(lastRow2 + 1, 2).Value = Worksheets("Sheet1").Cells(i, 2).Value
            Else
                obj.Offset(0, 1).Value = obj.Offset(0, 1).Value & _
                    Worksheets("Sheet1").Cells(i, 2).Value
            End If
            Set obj = Nothing
        Next i
    End With
End Sub

CONCATENATEが配列数式に使えたら関数1行でできるのだけどね。

EXCELの関数では無理だと思います。

VBAでユーザ関数を作成するしかないと思います。

具体的には

　Sheet2!B2に =文字連結(A2,Sheet1!$A$2:$B$5,2)

VBAは

Function 文字連結(検索値, 範囲 As Range, 列番号 As Integer)
 文字連結 = ""
 For I = 1 To 範囲.Rows.Count
  If 検索値 = 範囲(I, 1) Then 文字連結 = 文字連結 & 範囲(I, 列番号).Value
 Next I
End Function

「文字連結」関数は「VLOOKUP」関数のように　検索値, 範囲, 列番号を指定します。

最初からシート２のＡ列にはＩＤが入っているのですね。

その場合は、もう少し簡単なコードになります。

Sub Macro()
    Dim lastRow As Long
    Dim lastRow2 As Long
    Dim i As Long
    Dim j As Long
    Dim str As String
    
    With Worksheets("Sheet2")
        lastRow = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        lastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
        For j = 2 To lastRow2
            str = ""
            For i = 2 To lastRow
                If .Cells(j, 1).Value = Worksheets("Sheet1").Cells(i, 1).Value Then
                    str = str & Worksheets("Sheet1").Cells(i, 2).Value
                End If
            Next i
            .Cells(j, 2).Value = str
        Next j
    End With
End Sub