MS ACCESSグループ/ソート順に

Question

MS ACCESSを使用中に問題があります。私は約1.2 Mioのエントリを持つテーブルを持っています。

*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は1.2 MIOエントリをループして名前かどうかを比較され、 COdeは同じであり、更新は有効な日付を更新し続けます。その1つが名前、コード、有効開始日を変更するとすぐに、最初のエントリから取得されます。その後、seconレコードセットは最初のレコードセットのレベルに設定されます。 この方法には時間がかかります....

もっとエレガントな方法がありますか？たぶんSQLと？グループを使用し、次に日付の最小値を使用します。この考えは私の心に浮かんだが、残念ながら同じ名前のコードを繰り返している。 :-(

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