ms-access - MS Access 一次转置一行

Question

我有一个 MS Access 数据库，我从表中提取数据，并每月进行大量 IIF/SUM 计算 - 在 Access 中进行 20-50 次计算。这些计算是针对每个区域进行的，最多 30 多个区域。

因此，我在区域上使用 GROUP BY 创建了一个临时输入表，该表在一个月内提取所有相关区域，并进行计算。那一点一切正常。
（下表作为示例。扩展为更多措施、区域、RPTDates。

进程将在多个数据源文件上运行，每个文件都有不同数量的度量、区域和 RPTDates - 从数据源到数据源，没有什么是相同的。）

地区	RPTD日期	测量1	措施2	措施3
区域A	28/02/2021	10	8	4
B区	28/02/2021	25	2	10
C区	28/02/2021	100	50	25

我之前在这里找到了一个很棒的转置函数（感谢原作者），并且当我只有一行数据时它可以工作。它将数组中的所有列/字段输出到另一个输出表：

我想做的是运行一个进程，其中每一行将分别运行转置进程，并将结果输出到输出表，输入表中的行数一样多。

期望的输出（排序现在无关紧要）：

地区	RPTD日期	测量 ID	RPT值
区域A	28/02/2021	测量1	10
B区	28/02/2021	测量1	25
C区	28/02/2021	测量1	100
区域A	28/02/2021	措施2	8
B区	28/02/2021	措施2	2
C区	28/02/2021	措施2	50
区域A	28/02/2021	措施3	4
B区	28/02/2021	措施3	10
C区	28/02/2021	措施3	25

当前代码：

Function transpose_DVC_L3R()


' Sub transpose_DVC_L3R()
' Transpose the Monthly Results for Data Source CODE:  DVC, Level 3 REGIONS Results

    Dim db As DAO.Database
    Dim tdfNewDef As DAO.TableDef
    Dim fldNewField As DAO.Field
    Dim rstSource As DAO.Recordset
    Dim rstTarget As DAO.Recordset
    Dim i As Integer, j As Integer
    Dim strSource As String
    Dim strTarget As String
    Dim sqlcode As String
    
    Dim t_array() As Variant
    Dim t_no_of_rows As Integer
    Dim t_no_of_columns As Integer
    Dim s_no_of_rows As Integer
    Dim s_no_of_columns As Integer
    
    On Error GoTo Transposer_Err
    
    
    ' Specific individual INPUT and OUTPUT Tables for Transpose function
    strSource = "TBL_DVC41X_DataSource_L3_Regions_INPUT"
    strTarget = "TBL_DVC41X_CurrMthOUTPUT_L3R_OUTPUT"
    
    
    ' *** UPDATE INPUT TABLE name here
      
    Set db = CurrentDb()
    Set rstSource = db.OpenRecordset("SELECT * FROM TBL_DVC41X_DataSource_L3_Regions_INPUT", dbOpenDynaset)
    
    
    
    rstSource.MoveLast
    
    t_no_of_rows = rstSource.Fields.Count
    t_no_of_columns = rstSource.RecordCount + 1
    s_no_of_columns = rstSource.Fields.Count
    s_no_of_rows = rstSource.RecordCount + 1


    ' *** UPDATE OUTPUT TABLE name here
    DoCmd.SetWarnings False
    sqlcode = "DELETE TBL_DVC41X_CurrMthOUTPUT_L3R_OUTPUT.* FROM TBL_DVC41X_CurrMthOUTPUT_L3R_OUTPUT"
   DoCmd.RunSQL sqlcode
    DoCmd.SetWarnings True

    ReDim t_array(t_no_of_rows, t_no_of_columns)

    ' Fill the first field of the array with
    ' field names from the original table.
    For i = 0 To t_no_of_rows - 1
       t_array(i, 0) = rstSource.Fields(i).Name

    Next i
    
    rstSource.MoveFirst
    
    ' Fill each column of the array
    ' with a record from the original table.
    For j = 0 To t_no_of_rows - 1
        ' Begin with the second field, because the first field
        ' already contains the field names.
        For i = 1 To t_no_of_columns - 1
       '     Debug.Print i & " " & j
      
            t_array(j, i) = rstSource.Fields(j)
   
            rstSource.MoveNext
        Next i
        rstSource.MoveFirst
    Next j
    
    ' Fill the target table with fields from the array
    Set rstTarget = db.OpenRecordset(strTarget)
    For j = 0 To t_no_of_rows - 1
        rstTarget.AddNew
        
        For i = 0 To t_no_of_columns - 1
  
            rstTarget.Fields(i) = t_array(j, i)
        Next i
        rstTarget.Update
    Next j
    
    db.Close
    
    'MsgBox ("finished")
' Exit Sub
Exit Function

Transposer_Err:

   Select Case Err
      Case 3010
         MsgBox "The table " & strTarget & " already exists."
      Case 3078
         MsgBox "The table " & strSource & " doesn't exist."
      Case Else
         MsgBox CStr(Err) & " " & Err.Description
   End Select

   'Exit Sub
   'Exit Function

' End Sub

End Function

有没有办法识别下一行并在转置函数中执行此操作并循环？

有没有办法识别和隔离输入表的下一行，并将其发送到单独的表以制作新的输入表？

标签： ms-accesstranspose