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

原始代码链接：

我有一个问题的后续问题，答案没有完全解决，但非常接近。在上面的原始代码链接中询问。网络上的单个页面实际上解决了以动态方式（特别是使用VBA）将一对多关系列中的多个值转换为每个相关值的单行的问题。这个问题的各种变体在这个网站上被问了十几次，没有一个答案像Vlado（回答这个问题的用户）那样，这是解决这个问题所必需的

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

为了达到这一点，我必须注释掉转置函数的db.executeupdatesql部分；从末尾算起的第三行到最后一行。如果我不对此进行注释，它仍然会生成表，但会抛出运行时错误3144（UPDATE语句中的语法错误），并且只创建第一行和所有具有正确标题的正确列（但单元格中仍然没有有效值）。下面是上面链接中的Vlado代码，但根据我的字段名需要进行了调整，并在定义的两个函数的开头设置了变量。第二个功能肯定工作正常

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

公共函数转置（）
Dim DestinationCount为整数，i为整数
Dim sql作为字符串，InSQL作为字符串，fieldsSql作为字符串，updateSql作为字符串，updateSql2作为字符串
Dim db作为DAO.Database，rs作为DAO.Recordset，grp作为DAO.Recordset
Dim诱惑为字符串，myTable为字符串
Dim Var1作为字符串，Var2作为字符串，Var3作为字符串，Var4作为字符串
要使用结果创建的表的TENTRABLE=“Transposed”值
myTable=“ConvergeCombined”'表或查询源的值，其中包含要转换的行和列
主要行的Var1=“Source”值
附加行的Var2=“Thru”值
Var3=“Destination””列的值（从行转换为列）
列名称前缀的Var4=“Dest”值
DestinationCount=GetMaxDestination
Set db=CurrentDb（）
如果不为null（DLookup（“Name”、“MSysObjects”、“Name=””&tentable&“”），则
DoCmd.DeleteObject可执行，可诱惑
如果结束
fieldsSql=“”
sql=“CREATE TABLE”&tentable&（&Var1&&CHAR，&Var2&&CHAR）
对于i=1到DestinationCount
fieldsSql=fieldsSql&“，”和Var4&“&i&”整数
接下来我
sql=sql&fieldsSql&“.”
db.Execute（sql）
insSql=“插入到“&attable&”（&Var1&“，&Var2&”）值（”
Set grp=db.OpenRecordset（“从”&myTable&“分组依据”&Var1&“，&Var2&”中选择不同的”&Var1&“，&Var2&”）
先走一步
不使用grp.EOF时请勿使用
sql=“”&grp（0）和“，”&grp（1）和“）”
db.executeinssql&sql
Set rs=db.OpenRecordset（“从”&myTable&“WHERE”&Var1&“=”&grp（0）&“和”&Var2&“=”&grp（1）&“中选择*”）
updateSql=“UPDATE”&attreable&“SET”
updateSql2=“”
i=0
先走一步
做而不做
i=i+1
updateSql2=updateSql2&&Var3&&i&&rs（2）&“，”在该执行行之前添加一个
Debug.Print updateSql
，将在SQL语句中看到不正确的语法。需要从updateSql2字符串中修剪尾随逗号。代码追加逗号和空格，但只修剪1个字符。从串联中消除空格或修剪2个字符。

Left（updateSql2，Len（updateSql2）-2）

updateSql2的连接使用Var3而不是Var4

源字段是ConvergeCombined中的数字类型，这会触发SELECT语句中的“类型不匹配”错误以打开记录集，因为撇号分隔符
Var1&“=”&grp（0）&“
-将它们从两个SQL语句中删除

此外，源值以转置方式保存到文本字段中，在“创建表”操作中将其设置为整数而不是字符。
在该执行行之前添加一个
Debug.Print updateSql
，并将在SQL语句中看到不正确的语法。需要从updateSql2字符串中修剪尾部逗号。代码附加了逗号和空格，但只修剪了1 character。从串联中消除空格或修剪2个字符。

Left（updateSql2，Len（updateSql2）-2）

updateSql2的连接使用Var3而不是Var4

源字段是ConvergeCombined中的数字类型，这会触发SELECT语句中的“类型不匹配”错误以打开记录集，因为撇号分隔符
Var1&“=”&grp（0）&“
-将它们从两个SQL语句中删除

此外，源值以转置方式保存到文本字段中，在创建表操作中将其设置为整数而不是字符。
因此在朋友的帮助下，我找到了它。事实证明，我需要两个函数，因为在我的例子中，一对多关系是双向的。我在下面的评论中解释了需要做些什么才能使它起作用。本质上，我是在我提出的问题（在静态表中预先定义字段名，因为任何人都需要的字段数量有限——无论如何不能超过256个字段，但事实并非如此）下进行第二次评论的
' For this code to work, create a table named "TransposedSend" with 8 columns: Source, Destination1, Destination2,...Destination7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason

Public Function TransposeSend()

    Dim i As Integer
    Dim rs As DAO.Recordset, grp As DAO.Recordset

    CurrentDb.Execute "DELETE * FROM TransposedSend", dbFailOnError

    CurrentDb.Execute "INSERT INTO TransposedSend (Source) SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source", dbFailOnError

    Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Source FROM ConvergeSend GROUP BY Source")
    grp.MoveFirst

    Do While Not grp.EOF
        Set rs = CurrentDb.OpenRecordset("SELECT Source, Destination, [Destination App Name] FROM ConvergeSend WHERE Source = " & grp(0))
        i = 0
        rs.MoveFirst
        Do While Not rs.EOF
            i = i + 1
            CurrentDb.Execute "UPDATE TransposedSend SET Destination" & i & " = '" & rs(1) & "', [Destination" & i & " App Name] = '" & rs(2) & "'" & " WHERE Source = " & grp(0)
            rs.MoveNext
        Loop
        grp.MoveNext
    Loop

End Function


' For this code to work, create a table named "TransposedReceive" with 8 columns: Destination, Source1, Source2,...Source7; OR however many you need
' Save the table, Edit it, change all field values to Number and remove the 0 as Default Value at the bottom
' Not changing the field values to Number causes the Insert Into function to append trailing spaces for no apparent reason

Public Function TransposeReceive()

    Dim i As Integer
    Dim rs As DAO.Recordset, grp As DAO.Recordset

    CurrentDb.Execute "DELETE * FROM TransposedReceive", dbFailOnError

    CurrentDb.Execute "INSERT INTO TransposedReceive (Destination) SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination", dbFailOnError

    Set grp = CurrentDb.OpenRecordset("SELECT DISTINCT Destination FROM ConvergeReceive GROUP BY Destination")
    grp.MoveFirst

    Do While Not grp.EOF
        Set rs = CurrentDb.OpenRecordset("SELECT Destination, Source, [Source App Name] FROM ConvergeReceive WHERE Destination = " & grp(0))
        i = 0
        rs.MoveFirst
        Do While Not rs.EOF
            i = i + 1
            CurrentDb.Execute "UPDATE TransposedReceive SET Source" & i & " = '" & rs(1) & "', [Source" & i & " App Name] = '" & rs(2) & "'" & " WHERE Destination = " & grp(0)
            rs.MoveNext
        Loop
        grp.MoveNext
    Loop

End Function