使用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
我非常感谢你的帮助并感激它。
问候
答案 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