MS Excel

Prostě se jedná o sledování výskytu nějakých kombinací.
Protože to zatím zkouším v DAO a mám k dispozici záznamy z cca 1000 dní, slepil jsem tuto prc.'Reference
'Microsoft Access 14.0 Object Library
'Microsoft Office 14.0 Access Database Engine Object Library

Private Sub Vyber_Test_11()
Const nTab As Byte = 24
Dim fxDB As String
Dim dbAcc As DAO.Database, rsTab As DAO.Recordset, strSQL As String
Dim kodID As Double, nXK As Integer, sumKombi As Double
Dim xTab As Byte, rsRd As Long, rsSl As Byte

fxDB = ThisWorkbook.Path & "\" & "NewDB.accdb"
Set dbAcc = OpenDatabase(fxDB)

'COUNT -------------------------------------------------------------------
strSQL = vbNullString
For xTab = 1 To nTab
strSQL = strSQL & " Union All SELECT XK FROM " & xTab
Next xTab
strSQL = Mid(strSQL, 12) & ";"

Set rsTab = dbAcc.OpenRecordset(strSQL)

With rsTab
.MoveLast
rsRd = .RecordCount
.Close
End With

'SUMA --------------------------------------------------------------------
sumKombi = 15500 * 1000 '(jeden den 15500) * (zatim dnu 1000) jen jako priklad

'AVG ---------------------------------------------------------------------
nXK = Round(sumKombi / rsRd, 0)

'IMPORT ------------------------------------------------------------------
strSQL = vbNullString
For xTab = 1 To nTab
strSQL = strSQL & " Union All SELECT * FROM " & xTab & " WHERE XK>=" & nXK
Next xTab
strSQL = Mid(strSQL, 12) & " ORDER BY XK DESC, ID ASC;"

Set rsTab = dbAcc.OpenRecordset(strSQL)

With rsTab
.MoveLast
rsRd = .RecordCount

If rsRd = 0 Then 'Pokud žádné záznamy, exit.
MsgBox "Zadny vyhovujici Zaznam"
Else
If rsRd > 1000 Then rsRd = 1000
.MoveFirst
Sheets("List1").Cells(1).Resize(rsRd, 2) = WorksheetFunction.Transpose(.GetRows(rsRd))
End If
.Close
End With

dbAcc.Close
Set rsTab = Nothing
Set dbAcc = Nothing
End Sub

Tato prc. je funkční. Pokračuji v dalším testování. Nepotřebuji to pro žádné šéfy, je to jen moje kůň. Al moc díky.
ps.
CurrentDb.DCount je v cyklu pomalejší než rs.RecordCountcitovat