MS ACCESS Group /连续排序

时间:2016-06-28 14:23:40

标签: ms-access access-vba

使用MS ACCESS时出现问题。我有一张约有1.2万个参赛作品的桌子。

*Column1   Column2      Column3*    
**Name       Code         Datum**

aaa           111          01.01.01

aaa           111          02.01.01

aaa           222          03.01.01

aaa           222          04.01.01

aaa           222          05.01.01

aaa           111          06.01.01

aaa           111          07.01.01

aaa           111          08.01.01

bbb           333          01.01.01

bbb           333          02.01.01

bbb           111          03.01.01

bbb           111          04.01.01

bbb           333          05.01.01

bbb           333          06.01.01

ccc           222          01.01.01

ccc           222          02.01.01

ccc           222          03.01.01

ccc           222          04.01.01

此表格应总结为:

**NAme      Code         ValidFrom     ValidTo

aaa           111          01.01.01        02.01.01

aaa           222          03.01.01        05.01.01       

aaa           111          06.01.01        08.01.01

bbb           333          01.01.01        02.01.01

bbb           111          03.01.01        04.01.01    

bbb           333          05.01.01        06.01.01

ccc           222          01.01.01        04.01.01

问题是我有一个VBA代码,它可以处理多个记录集,一个循环遍历1.2 mio条目,并比较Name和COde是否相同,因此更新会一直更新Valid To date他们更改名称,代码和有效起始日期取自第一个条目。之后,secon记录集设置在第一个记录集的级别上。 然而,这种方法需要数小时......

有更优雅的方式吗?也许用SQL?使用group by然后min max表示日期。我想到了这个想法,但不幸的是我在同一个名字中重复了代码。 : - (

PS:我非常需要以下表格:

Name   Code            Valid From                     Valid to

aaa    111,222,111     01.01.01,03.01.01,06.01.01     02.01.01,05.01.01,08.01.01

bbb    333,111,111     01.01.01,03.01.01,05.01.01     02.01.01,04.01.01,06.01.01

ccc    222             01.01.01                       04.01.01

我非常感谢你的帮助并感激它。

问候

2 个答案:

答案 0 :(得分:0)

您可以在表格中添加自动编号字段,保留上面显示的排序吗?

如果是这样,我的尝试是:

SELECT Table1Start.id, Table1Start.Name, Table1Start.Code, Table1Start.Datum AS ValidFrom, 
    Min(Table1END.Datum) AS ValidThru
FROM 
    (SELECT Table1.* 
        FROM Table1
        WHERE ((((SELECT id FROM Table1 T WHERE T.id = Table1.id -1 AND
           (T.Name <> Table1.Name Or T.Code <> Table1.Code))) Is Not Null)) OR 
           (((Table1.id)=1))) AS Table1Start INNER JOIN 
    (SELECT Table1.*
        FROM Table1
        WHERE ((((SELECT id FROM Table1 T WHERE T.id = Table1.id +1 AND 
           (T.Name <> Table1.Name Or T.Code <> Table1.Code))) Is Not Null)) OR 
           (((Table1.id)=DMax("id","Table1")))) AS Table1END 
        ON (Table1Start.Code = Table1END.Code) AND (Table1Start.Name = Table1END.Name)
WHERE (((Table1END.Datum)>[Table1Start].[Datum]))
GROUP BY Table1Start.id, Table1Start.Name, Table1Start.Code, Table1Start.Datum
ORDER BY Table1Start.id

至少可以让你到第一个表摘要。

答案 1 :(得分:0)

此代码通过GetRows函数使用数组来处理内存中的所有内容。

假设您的数据布局与您的示例相似,它应该通过您的百万行进行尖叫。

Public Sub ProcessDatumList()

    ' Change these values to match your query name and fields
    ' ***************************************************
    Const QRY_DATA_TABLE    As String = "data"

    Const FIELD_1           As String = "lookupname"
    Const FIELD_2           As String = "lookupcode"
    Const FIELD_3           As String = "lookupdatum"

    Const NAME_COL          As Integer = 0
    Const CODE_COL          As Integer = 1
    Const DATUM_COL         As Integer = 2
    ' ***************************************************


    Const BATCH_ROWS_TO_RETURN  As Long = 50000

    Const RS_SQL            As String = "SELECT [" & FIELD_1 & "],[" & FIELD_2 & "],[" & FIELD_3 & "] FROM [" & QRY_DATA_TABLE & "]"

    Dim rs                  As DAO.Recordset
    Dim strSQL              As String

    Dim datum               As Variant
    Dim lngRowsReturned     As Long

    Dim lngRecNum           As Integer

    Dim strName             As String
    Dim lngCode             As Long
    Dim strDatum            As String

    Dim strFirstDatum       As String

    Dim strLastName         As String
    Dim lngLastCode         As Long
    Dim strLastDatum        As String

    Dim strCodeList         As String
    Dim strDatumFrom        As String
    Dim strDatumTo          As String

    Dim tim1                As Double
    Dim tim2                As Double

    strSQL = RS_SQL ' & ORDER_BY

    tim1 = Timer
    Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot, dbReadOnly)

    ' Get this started by loading first two rows
    If GetRowsOK(rs, 2, datum) Then
        ' Name = Field 1 : datum(0, intRecord)
        ' Code = Field 2: datum(1, intRecord)
        ' Datum = Field 3: datum(2, intRecord)

        ' Start from and to datum lists
        strFirstDatum = datum(DATUM_COL, 0) ' Record 1
        strLastDatum = datum(DATUM_COL, 1) '' Record 2

        ' Initialize code lists with first code
        strCodeList = datum(CODE_COL, 0)

        ' Store name of first two records
        strLastName = datum(NAME_COL, 1)

        strDatumFrom = strFirstDatum
    Else
        MsgBox "Problem Getting Data: " & vbCrLf & Err.Description, vbInformation + vbOKOnly, "Error in Data"
        Exit Sub
    End If

    Do Until rs.EOF

        ' Loop by loading big batches of records into memory and processing arrays

        If GetRowsOK(rs, BATCH_ROWS_TO_RETURN, datum) Then
            lngRowsReturned = UBound(datum, 2) + 1 'records retrieved
            If lngRowsReturned > 0 Then

                For lngRecNum = 0 To UBound(datum, 2)

                    strName = datum(NAME_COL, lngRecNum)
                    lngCode = datum(CODE_COL, lngRecNum)
                    strDatum = datum(DATUM_COL, lngRecNum)

                    If strName = strLastName Then ' Update Code List

                        If lngCode <> lngLastCode Then ' New Code
                            ' Add new code to lists for code/datum from
                            strCodeList = strCodeList & "," & lngCode
                            strDatumFrom = strDatumFrom & "," & strDatum

                            ' Store last datum to match last name/code combo
                            If strDatumTo = "" Then
                                strDatumTo = strLastDatum
                            Else
                                strDatumTo = strDatumTo & "," & strLastDatum
                            End If
                        End If

                    Else
                        ' New Name and code
                        ' Store last datum to match last name/code combo
                        If strDatumTo = "" Then
                            strDatumTo = strLastDatum
                        Else
                            strDatumTo = strDatumTo & "," & strLastDatum
                        End If

                        ' write out full list for last name
                        Debug.Print strLastName, strCodeList, strDatumFrom, strDatumTo

                        ' Initialize new name, code and datum list
                        strCodeList = lngCode
                        strDatumFrom = strDatum
                        strDatumTo = ""

                    End If

                    ' Save values to compare to next record
                    strLastName = strName
                    lngLastCode = lngCode
                    strLastDatum = strDatum

                Next lngRecNum

' Write out last entry
                ' Store last datum to match last name/code combo
                If strDatumTo = "" Then
                    strDatumTo = strLastDatum
                Else
                    strDatumTo = strDatumTo & "," & strLastDatum
                End If

                Debug.Print strLastName, strCodeList, strDatumFrom, strDatumTo

            Else
                Exit Do
            End If
        Else
            MsgBox "Problem Getting Data: " & vbCrLf & Err.Description, vbInformation + vbOKOnly, "Error in Data"
            Exit Do
        End If
    Loop

    tim2 = Timer
    Debug.Print tim2 - tim1 & " seconds to complete"

    rs.Close
    Set rs = Nothing

End Sub