horizontaal ontdubbelen

[OctaFish]

Een loop van 52 uur? Bloody hell.... dan heb je ofwel de grootste database ter wereld in gebruik, ofwel de langzaamste pc die je kon vinden (een pc-xt met 512 kb intern geheugen met een harde schijf van 20 Mb wellicht ). Maar dit riekt naar een proces waar een hoop aan verbeterd kan worden...
Ter stimulatie dus hier de versie waarbij de berekening gewoon in een query gedaan wordt. Is ook een stuk sneller als op een formulier. Bekijk het volgende week woensdag (als je pech hebt loopt je db na 40 uur vast, en kan je weer opnieuw beginnen...) maar eens.

 

[combi]

Beste ,
traag nee , 128 gb ram (kan niet meer plaatsen dan er beschikbaar is)
os-en op ssd (samsung 6gb read write ) intel 16 cores I7 proc dus
en dit 13 stuks ,
52 uur is als minuut voor mij , zie posts enkele jaren terug , loopke maakt zo'n 15000 mdb 's per uur aan ,
full automated en zo'n in wiskunde term uitgedrukt een 217de macht aan berekeningen ,
evolutie volgende was dit in 2003 zo'n 2 jaar , nu sinds 2007 serieuze opmars kwa technologie en rekenkracht
zal ik dit nog overleven.

idee en uitvoering dateert al van het jaar 1989 , levenswerkje dus .

doel timebending datamining =de toekomst niet nodig te voorspellen als je er al in zit.
mvg
yves

 

[combi]

Beste , kan laatste bijlage niet openen
ongekende indeling , of convertie niet gelukt
kan je die opnieuw posten
fout bij convertie,
1 de bijlage eventjes bekeken op pc in wagen , zie er goed uit
2de bijlage en query zou handiger zijn ,daar er macro voor automatisatie gebruikt zullen worden
maar kan deze niet openen fout ibij uitpakken
mvg
yves

 

[OctaFish]

Da's vreemd, bij mij doet-ie het prima op mijn werkplek. Voor het gemak dus maar even de functie gepost, dan kun je hem zelf wel in een module plakken.

Function ResultaatBerekenen(Tabel As String, Veld As String, ID As Variant) As String
Dim sResult As String, strSQL As String
Dim rst As DAO.Recordset
Dim arr() As Variant, myArray() As Variant
Dim i As Integer, j As Integer, x As Integer, n As Integer, m As Integer
Dim b As Boolean

    strSQL = "SELECT * FROM [" & Tabel & "] WHERE [" & Veld & "] = " & ID
    Set rst = CurrentDb.OpenRecordset(strSQL)
    With rst
        For i = 1 To .Fields.Count - 2
            b = False
            If i = 1 Then
                ReDim arr(0, 1)
                arr(0, 0) = .Fields(i)
                arr(0, 1) = 1
            Else
                For j = LBound(arr) To UBound(arr)
                    If arr(j, 0) = .Fields(i).Value Then
                        b = True
                        Exit For
                    End If
                Next j
                If b = True Then
                    arr(j, 1) = arr(j, 1) + 1
                Else
                    myArray = arr
                    m = UBound(myArray) + 1
                    n = 1
                    ReDim arr(m, 1)
                    For x = 0 To m - 1
                        arr(x, 0) = myArray(x, 0)
                        arr(x, 1) = myArray(x, 1)
                    Next x
                    arr(UBound(arr), 0) = .Fields(i).Value
                    arr(UBound(arr), 1) = 1
                End If
            End If
        Next i
        For x = LBound(arr) To UBound(arr)
            If sResult <> "" Then sResult = sResult & ", "
            sResult = sResult & arr(x, 1)
        Next x
        ResultaatBerekenen = sResult
    End With

End Function

En je gebruikt hem zo in een query:

Result: ResultaatBerekenen("test";"TK";[tk])