Question

我在访问中有一个查询，如下所示

select field1, column_date, sum(qty) from table
group by field1, column_date
union all
select field1, 'subtotal' as column_date, sum(qty) from table
group by field1
union all
select '', 'Grand Total' as column_date, sum(qty) from table

上面的代码显示输出如下：

field1 | column_date | qty1 | qty2 | qty3 | qty4
xyz    | 1 June 2012 | 23   | 36   | 343  | 45
xyz    | 2 June 2012 | 24   | 33   | 123  | 12
xyz    | 3 June 2012 | 55   | 25   | 21   | 45
**xyz    | subtotal    | 102  | 94   | 487  | 102**
abc    | 1 June 2012 | 15   | 23   | 46   | 21
abc    | 2 June 2012 | 24   | 81   | 25   | 21
abc    | 7 June 2012 | 33   | 25   | 43   | 21 
**abc    | subtotal    | 72   | 129  | 114  | 63**
etc......

但我不想每次都重复field1值。我只想在顶部显示一次，如下所示。

field1 | column_date | qty1 | qty2 | qty3 | qty4
xyz    | 1 June 2012 | 23   | 36   | 343  | 45
       | 2 June 2012 | 24   | 33   | 123  | 12
       | 3 June 2012 | 55   | 25   | 21   | 45
       | subtotal    | 102  | 94   | 487  | 102
abc    | 1 June 2012 | 15   | 23   | 46   | 21
       | 2 June 2012 | 24   | 81   | 25   | 21
       | 7 June 2012 | 33   | 25   | 43   | 21 
       | subtotal    | 72   | 129  | 114  | 63**
etc......

是可以使用查询还是使用VBA代码？请帮忙。

Answer 1

OP已初步了解VBA，因此对于可能使用此代码的其他人，请在阅读时牢记这一点，并注意代码中的注释。

请将此VBA视为可能的解决方案。我在访问2007数据库中测试了这个。我创建了一个带有按钮的表单，其中on_click事件调用此子例程。

执行此操作后，您可以让按钮on_click事件调用VBA模块，该模块将“tbl_output”中包含的数据导出到excel电子表格。

下面是一个屏幕截图，显示了它按要求工作的证据：

Proof of records with proper roll-up

这是我提出的代码，这使得这成为可能。这是我对如何实现最终结果的解释：

Option Explicit

Public Sub QueryRollUp()

Dim db As Database
Dim rst_Input As DAO.Recordset
Dim rst_Output As DAO.Recordset
Dim strSQL As String
Dim tdfNew As TableDef
Dim tdfLoop As TableDef
Dim prpLoop As Property
Dim s_tdef As String
Dim s_CurrentRollUp As String
Dim s_CurrentField1 As String
Dim s_CurrentDate As String
Dim s_CurrentQty1 As Integer
Dim s_CurrentQty2 As Integer
Dim s_CurrentQty3 As Integer
Dim s_CurrentQty4 As Integer
Dim i As Integer

' If the subroutine is going to access parts of the database (tables, queries, etc.)
' you must have a representation of the database in the code.
' In this code, I use 'db' as that representation.
' VBA has a shortcut for defining the database that is currently open, and that is         'CurrentDB'.
' You can define an external database if necessary, but that goes beyond the scope of     this example.
' The below line sets the database code object 'db' equal to this database

Set db = CurrentDb

' The next step is to create a new table programaitcally for the output to go
' I choose to do this in code instead of building it in table designer
' because I want to ensure you get the correct tbl_Output that my code is
' expecting.  If you were desining a new module, and new how the correct table needed
' to be designed, you can omit everything between the hash marks

'#####################################################################################

' This current database.
' I like to use 'With' so I don't have to keep typing the name.
' I can just type .something and the code knows I really mean db.something
' Each 'With' must have an 'End With' to let the code know when you are no longer
' wanting it to assume you are using the short cut.

With db

'this loops trough all of the items in the table definitions
'the looping logic takes place between the % signs
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
For Each tdfLoop In .TableDefs
    ' Check the name of an item 'tdfLoop.Name' to see if it the
    ' same as "tbl_Output".
    If tdfLoop.Name = "tbl_Output" Then
        ' We are going to create this table later.
        ' If the table already exists, it will cause an error and
        ' the code will halt.  Deleting the table prevents the
        ' conflict.

        db.TableDefs.Delete "tbl_Output"

    End If

' This bit of code moves to the next item in the table definitions collection
' and then loops back and tests for tbl_Output again.
Next tdfLoop
'%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
End With

' Create a new TableDef object.
' This assigns the object "tbl_Output" to a variable so I can access it
' shorthand.  The variable is called 'tdfNew'
Set tdfNew = db.CreateTableDef("tbl_Output")

' Using the 'With' again, but this time is tdfNew, and not db that
' I am shortcutting.  Remember that there is an implied 'tdfNew'
' in front of each .Fields.Append an also .CreateField(...)

With tdfNew
' Create fields and append them to the new TableDef
' object. This must be done before appending the
' TableDef object to the TableDefs collection of the
' database.

' Each line here adds a new field to the table
' This is the code equivilent of designing a table
' in the graphical UI
.Fields.Append .CreateField("name", dbText)
.Fields.Append .CreateField("column_date", dbText)
.Fields.Append .CreateField("qty1", dbInteger)
.Fields.Append .CreateField("qty2", dbInteger)
.Fields.Append .CreateField("qty3", dbInteger)
.Fields.Append .CreateField("qty4", dbInteger)

' Append the new TableDef object to the database.
' The net effect of this is to create a new table
' within the database using the information above.
db.TableDefs.Append tdfNew

End With

'#####################################################################################
' Open rst_Output as a recordset tied to new 'tbl_Output' table\
' the .OpenRecordset creates an incode representation of a database table.
' All of the specified table columns are recreated, and populated.  If no
' specific columns are listed (such as in a query), then it defaults to all columns.

' When using the .OpenRecordset("table_name", [type]) method, there are several [types]
' you can choose.  The type you choose determines the way it opens in the code
' and what you can do with it.  The most flexible is dbOpenDynaset, but is generally     slower
' in performacne with huge amounts of data.  dbOpenTable is equivelant to opening the     table directly

Set rst_Output = db.OpenRecordset("tbl_Output", dbOpenTable)

' Create query string to pull data from the database.
' For readability I have split this process up on several lines.
' Each time a new line is needed you must add the
' new information to the information you already have
' This is accomplished by doing strSQL = strSQL & "..." on each line after the first
' If you just did strSQL = "..." for each line, you would overwrite what was there     before

strSQL = "select field1, column_date, sum(qty1) as Total1, sum(qty2) as Total2,     sum(qty3) as Total3, sum(qty4) as Total4 "
strSQL = strSQL & " from [table]"
strSQL = strSQL & " group by field1, column_date"
strSQL = strSQL & " union all"
strSQL = strSQL & " select field1, 'subtotal' as column_date, sum(qty1) as Total1, sum(qty2) as Total2, sum(qty3) as Total3, sum(qty4) as Total4 "
strSQL = strSQL & " from [table]"
strSQL = strSQL & " group by field1"
strSQL = strSQL & " union all"
strSQL = strSQL & " select '', 'Grand Total' as column_date, sum(qty1) as Total1,     sum(qty2) as Total2, sum(qty3) as Total3, sum(qty4) as Total4 "
strSQL = strSQL & " from [table]"
strSQL = strSQL & " order by field1 desc, column_date asc"

' After the above code, your whole query is now stored in strSQL.

' Execute query and populate rst_Input with the result set.
' Ensure full recordset has been retrieved before continuing.
' This becomes more important the larger the result set is.
' The dbOpenSnapshot type is like creating a virtual image
' of the data just queried.  Like a photo, it can't be changed,
' only looked at.  Since we only want to read the data, this
' is a more optimal type of OpenRecordset than a dynaset.
' All of the contents are moved into rst_Input.

Set rst_Input = db.OpenRecordset(strSQL, dbOpenSnapshot)

' Now we are going to manipulate the information
' returned by the query as it is stored inside the
' rst_Input variable.
With rst_Input
' The .MoveLast forces the recordset to go the very last
' record of the returned query.  Omitting this step could
' result in the code starting before all of the data is
' returned by the query.
' .MoveFirst returns to the top of the list once all data
' is returned

.MoveLast
.MoveFirst

' Begin process of evaluating query results
' This will keep looping until the current record is the
' end of the returned data.
Do Until .EOF

    ' Use 'i' as the index of the current roll-up value.
    ' Default this value to 1 for the first each time the field1 value changes.
    ' The example  has 'xyz' and 'abc'.
    i = 1

    ' Move the data from the query which is stored in
    ' the rst_Input from the fields to variables
    s_CurrentRollUp = .Fields("field1").Value
    s_CurrentField1 = .Fields("field1").Value
    s_CurrentDate = .Fields("column_date").Value
    s_CurrentQty1 = .Fields("total1").Value
    s_CurrentQty2 = .Fields("total2").Value
    s_CurrentQty3 = .Fields("total3").Value
    s_CurrentQty4 = .Fields("total4").Value

    ' While working with all field1 values (i.e. 'xyz') values which are the same
    ' the following 'Do While' loop will execute.
    Do While s_CurrentRollUp = s_CurrentField1
        ' If this is the firs time the values match do everything betwen the '#' marks
        If i = 1 Then
        '#############################################

            ' If the CurrentDate value is not a real date
            ' do the following
            If s_CurrentDate = "Grand Total" Then

                With rst_Output

                    ' .AddNew tells the recordset we are adding a new record
                    .AddNew

                    ' Here we use a '!' (pronounced 'bang') to let VBA know
                    ' we are accessing members of a collection, and not a
                    ' method of doing something with rst_Output.
                    !column_date = s_CurrentDate
                    !qty1 = s_CurrentQty1
                    !qty2 = s_CurrentQty2
                    !qty3 = s_CurrentQty3
                    !qty4 = s_CurrentQty4

                    ' .Update tells the recordset we are done adding, and to save it
                    .Update
                End With

            ' If the CurrentDate value is a real date
            ' do the following
            Else
                With rst_Output
                    .AddNew

                    !Name = s_CurrentField1
                    !column_date = s_CurrentDate
                    !qty1 = s_CurrentQty1
                    !qty2 = s_CurrentQty2
                    !qty3 = s_CurrentQty3
                    !qty4 = s_CurrentQty4
                    .Update
                End With
            End If
            ' set index to optimistically reflect second record of rollup
            ' Values above '1' tell the logic that we are still using the
            ' same field1 ('xyz') value, but are no longer on the first
            ' occurance of the 'xyz' value.
            i = i + 1

            ' move to the next record of the input recordset
            .MoveNext

            'test if last move is the end of file
            If .EOF Then
                'exit sub if the end of file has been reached.
                Exit Sub
            End If

            ' get next field1 value to test in the do while exit condition
            If IsNull(.Fields("field1").Value) Then
                s_CurrentField1 = " "
            Else
                s_CurrentField1 = .Fields("field1").Value
            End If

        '#############################################
        ' If there is another record with the same field1 value (i.e. 'xyz'
        ' then do the following logic.
        ' This will replace the 'xyz' with an empty value so it does not
        ' show up in the tbl_Output table
        ElseIf i > 1 Then

            ' Move the data from the query which is stored in
            ' the rst_Input from the fields to variables
            s_CurrentField1 = " "
            s_CurrentDate = .Fields("column_date").Value
            s_CurrentQty1 = .Fields("total1").Value
            s_CurrentQty2 = .Fields("total2").Value
            s_CurrentQty3 = .Fields("total3").Value
            s_CurrentQty4 = .Fields("total4").Value

            With rst_Output
                .AddNew
                !Name = s_CurrentField1
                !column_date = s_CurrentDate
                !qty1 = s_CurrentQty1
                !qty2 = s_CurrentQty2
                !qty3 = s_CurrentQty3
                !qty4 = s_CurrentQty4
                .Update
            End With

            ' Set index to optimistically reflect second record of rollup
            i = i + 1

            ' Move to the next record of the input recordset
            .MoveNext

            ' Get next field1 value to test in the do while exit condition
            ' The IsNull makes sure that in the event that no information
            ' exists in the field1 column of the table, it is replaced with
            ' a " " character to avoid an invalid use of NULL in the variable
            If IsNull(.Fields("field1").Value) Then
                s_CurrentField1 = " "
            Else
                s_CurrentField1 = .Fields("field1").Value
            End If

        End If

    Loop  'do while

Loop 'do until

End With

' Now that everything has finished, it's proper coding technique
' to release all of the resources consumed by our data containing
' variables.
db.Close
rst_Output.Close
rst_Input.Close
Set db = Nothing
Set rst_Output = Nothing
Set rst_Input = Nothing

End Sub

访问小计 - 按字段分组只应出现一次

1 个答案: