1カラム複数レコードを1カラム1レコードに結合するAccessマクロ


なにをしたいの?

こういうレコードを

 カラム1
 山田
 佐藤
 鈴木

こうしたい。

expr1
山田,佐藤,鈴木

方針

Microsoft ActiveX DAO + マクロ でやるぞ

実装

参照設定

マクロ(標準モジュール)編集中に ツール→参照設定 で”Microsoft ActiveX Data Objects 6.1 Library

マクロコード

Public Function DBSelect(ByVal strQuerySQL As String, _
                         Optional ByVal strSeparator As String = ";") As String
On Error GoTo Err_DBSelect
    Dim I     As Integer
    Dim J     As Integer
    Dim R     As Integer
    Dim C     As Integer
    Dim M     As Integer
    Dim N     As Integer
    Dim rst   As ADODB.Recordset
    Dim fld   As ADODB.Field
    Dim Datas As String
        
    Set rst = New ADODB.Recordset
    ' =================
    '  Begin With: rst
    ' -----------------
    With rst
        .Open strQuerySQL, _
             CurrentProject.Connection, _
               adOpenStatic, _
               adLockReadOnly
         If Not .BOF Then
            M = .RecordCount - 1
            N = .Fields.Count - 1
            .MoveFirst
            For R = 0 To M
                For C = 0 To N
                    Datas = Datas & .Fields(C) & strSeparator
                Next C
                .MoveNext
            Next R
         End If
    End With
    ' ---------------
    '  End With: rst
    ' ===============

Exit_DBSelect:
    On Error Resume Next
    DBSelect = Left(Datas, Len(Datas) + (Len(Datas) > 0))
    Exit Function

Err_DBSelect:
    MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
            "・Err.Description=" & Err.Description & Chr$(13) & _
            "・SQL Text=" & strQuerySQL, _
            vbExclamation, " 関数エラーメッセージ"
    Resume Exit_DBSelect
End Function

クエリ

expr1: dbselect("SELECT カラム1 FROM コード表 WHERE 廃止=0 ORDER BY ソートキー;",",")

最後の”,”を変更すればセパレータを変更できる

参考

Access VBA 入門講座http://accessvba.pc-users.net/ado/

教えて!goo アクセス 同じフィールド(テキスト型)のレコードを連結させたい https://oshiete.goo.ne.jp/qa/3023548.html