MS ACCESS Group /連續排序

Question

使用MS ACCESS時出現問題。我有一張大約有120萬個參賽作品的桌子。

*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項循環和比較該名稱是否和COde是相同的，並且更新因此不斷更新有效日期，只要其中一個更改名稱，代碼和有效日期取自第一個條目。之後，secon記錄集被設置爲第一個記錄集的級別。 然而，這種方法需要數小時....

有沒有更優雅的方式？也許與SQL？使用group by，然後使用min max來獲取日期。這個想法出現在我的腦海裏，但不幸的是我在同一個名字中重複了代碼。 :-(

PS：Idially我需要它的格式如下：。

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 

我對你的幫助非常感激和欣賞它

問候

Answer 1

你可以添加一個自動編號字段到表保存你上面顯示的排序？

如果是這樣，這是我的企圖：

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 

這應該讓你至少得到第一個表的總結。

Answer 2

此代碼通過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