MS-Access使用VBA将可变行值动态转换为可变列值

原始代码链接：MS Access-将行值转换为列值

我有一个跟进的问题，答案没有完全解决，但很快就解决了。在上面的原始代码链接中询问了它。实际上，这是网络上的单个页面，该问题专门针对动态地使用VBA解决了将一对多关系列中的多个值转换为每个相关值的单个行的问题。在此站点上已经询问过该问题的变体大约十二次，并且从字面上看，没有一个答案能像Vlado（回答问题的用户）那样远，这是解决此问题的必要条件。

我接受了Vlado在该链接中发布的内容，根据我的需要对其进行了调整，进行了一些基本的清理，解决了所有的故障排除和语法问题（甚至删除了一个声明未使用的变量：f As Variant），然后发现它几乎可以一直工作。它正确地产生与值表的前两列，正确使用迭代变量头数列的正确数量，但无法填充值内的细胞每一个相关的“多值”的。很近！

为了达到目的，我必须注释掉db.Execute Transpose Function的updateSql部分；从末到第三排。如果我不对此进行注释，它仍会生成表，但会引发运行时错误3144（UPDATE语句中的语法错误），并且仅创建第一行和所有具有正确标题的正确列（但仍然无效）单元格中的值）。下面是上面链接中的Vlado代码，但根据我的字段名称需要进行了调整，并在定义的两个Function的每个函数的开头设置了变量。第二个功能肯定可以正常工作。

Public Function Transpose()

    Dim DestinationCount As Integer, i As Integer
    Dim sql As String, insSql As String, fieldsSql As String, updateSql As String, updateSql2 As String
    Dim db As DAO.Database, rs As DAO.Recordset, grp As DAO.Recordset
    Dim tempTable As String, myTable As String
    Dim Var1 As String, Var2 As String, Var3 As String, Var4 As String

    tempTable = "Transposed"        'Value for Table to be created with results
    myTable = "ConvergeCombined"    'Value for Table or Query Source with Rows and Columns to Transpose
    Var1 = "Source"                 'Value for Main Rows
    Var2 = "Thru"                   'Value for Additional Rows
    Var3 = "Destination"            'Value for Columns (Convert from Rows to Columns)
    Var4 = "Dest"                   'Value for Column Name Prefixes

    DestinationCount = GetMaxDestination
    Set db = CurrentDb()
    If Not IsNull(DLookup("Name", "MSysObjects", "Name='" & tempTable & "'")) Then
        DoCmd.DeleteObject acTable, tempTable
    End If

    fieldsSql = ""
    sql = "CREATE TABLE " & tempTable & " (" & Var1 & " CHAR," & Var2 & " CHAR "
    For i = 1 To DestinationCount
        fieldsSql = fieldsSql & ", " & Var4 & "" & i & " INTEGER"
    Next i
    sql = sql & fieldsSql & ")"
    db.Execute (sql)

    insSql = "INSERT INTO " & tempTable & " (" & Var1 & ", " & Var2 & ") VALUES ("
    Set grp = db.OpenRecordset("SELECT DISTINCT " & Var1 & ", " & Var2 & " FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & "")
    grp.MoveFirst

    Do While Not grp.EOF
        sql = "'" & grp(0) & "','" & grp(1) & "')"
        db.Execute insSql & sql
        
        Set rs = db.OpenRecordset("SELECT * FROM " & myTable & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'")
        updateSql = "UPDATE " & tempTable & " SET "
        updateSql2 = ""
        i = 0
        rs.MoveFirst

        Do While Not rs.EOF
            i = i + 1
            updateSql2 = updateSql2 & "" & Var3 & "" & i & " = " & rs(2) & ", " ' <------- MADE CHANGE FROM (3) to (2)
            rs.MoveNext
        Loop

        updateSql = updateSql & Left(updateSql2, Len(updateSql2) - 1) & " WHERE " & Var1 & " = '" & grp(0) & "' AND " & Var2 & " = '" & grp(1) & "'"
        db.Execute updateSql ' <-- This is the point of failure
        grp.MoveNext
    Loop
End Function

Public Function GetMaxDestination()

    Dim rst As DAO.Recordset, strSQL As String
    myTable = "ConvergeCombined"    'Value for Table or Query Source with Rows and Columns to Transpose
    Var1 = "Source"                 'Value for Main Rows
    Var2 = "Thru"                   'Value for Additional Rows
    Var3 = "Destination"            'Value for Columns (Convert from Rows to Columns)

    strSQL = "SELECT MAX(CountOfDestination) FROM (SELECT Count(" & Var3 & ") AS CountOfDestination FROM " & myTable & " GROUP BY " & Var1 & ", " & Var2 & ")"
    Set rst = CurrentDb.OpenRecordset(strSQL)
    GetMaxDestination = rst(0)
    rst.Close
    Set rst = Nothing
End Function

样品表：

样本数据：