Access: Dubbele tellen in laatste 5 records

[dannyflee]

Hallo,

Ik had een excelfile die ik door de grote hoeveelheid data om aan het zetten ben naar een Access database.
Echter heb ik een berekening waarvan ik niet goed weet hoe ik deze in access voor elkaar moet krijgen.
Hopelijk hebben jullie hier een oplossing voor.

Ik heb in een query 5 kolommen met getallen.
Die kolommen heten getal1;getal2;......getal5

nu wil ik een nieuwe kolom berekenen hoeveel dubbele getallen er zitten in de laatste 5 records. (dus huidige record en de 4 die erboven staan).

Bijvoorbeeld:

2 8 21 37 46
5 7 12 19 26
7 8 34 36 38
5 11 12 27 32
10 16 30 41 45

Dan zou het resultaat 4 moeten zijn (5= dubbel, 7 is dubbel; 8=dubbel; 12 is dubbel)

Had de vraag al neergelegd in de Access categorie, maar waarschijnlijk toch meer een gevalletje VBA

 

[Elsendoorn2134]

Danny,

Dit is inderdaad meer een gevalletje VBA, met SQL is dit niet te doen.
Hierbij een VBA script wat het probleem voor je oplost.

Public Sub TelDubbelen()

Dim db As Database
Dim rs As Recordset
Dim lTeller As Long
Dim nTeller As Integer
Dim nDubbelen As Integer
Dim lMatrix(101) As Long

Set db = CurrentDb()
Set rs = db.OpenRecordset("Tabel1", dbOpenDynaset)
rs.MoveLast
lTeller = rs.RecordCount
rs.MoveFirst

Do While rs.AbsolutePosition <= lTeller - 5
    For nTeller = 1 To 5
        lMatrix(rs.Fields("Getal1")) = lMatrix(rs.Fields("Getal1")) + 1
        lMatrix(rs.Fields("Getal2")) = lMatrix(rs.Fields("Getal2")) + 1
        lMatrix(rs.Fields("Getal3")) = lMatrix(rs.Fields("Getal3")) + 1
        lMatrix(rs.Fields("Getal4")) = lMatrix(rs.Fields("Getal4")) + 1
        lMatrix(rs.Fields("Getal5")) = lMatrix(rs.Fields("Getal5")) + 1
        rs.MoveNext
    Next
    rs.MovePrevious
    nDubbelen = 0
    For nTeller = 1 To 100
        If lMatrix(nTeller) > 1 Then
            nDubbelen = nDubbelen + 1
        End If
        lMatrix(nTeller) = 0
    Next
    rs.Edit
    rs.Fields("Dubbelen") = nDubbelen
    rs.Update
    rs.Move -3
Loop

MsgBox "Alle dubbelen geteld en in de database gezet.", vbInformation, "Klaar"

End Sub

Een paar vooronderstellingen:
- Binnen de matrix zijn alle getallen onder de honderd.
- Het veld met de dubbelen wordt "Dubbelen" genoemd.

Wel een waarschuwing, binnen VBA wordt een tabel doorgelopen op basis van de ingevoerde gegevens, niet
op basis van een al dan niet aanwezige index.
Als je bijvoorbeeld indexeert op basis van Getal1 krijg je hele vreemde uitkomsten omdat de volgorde die je
ziet misschien niet de volgorde is die VBA aanhoud.
Ik stel voor dat je eerst de tabel sorteert voordat je deze macro er op los laat.

Veel Succes.

 

[dannyflee]

Elsendoorn,

Bedankt. Het werkt inderdaad. Hij geeft alle resultaten.
Alleen geeft hij wel een fout melding op het eind.
(ongeldig gebruik van 0)

Bij fout opsporing geeft hij:
lMatrix(rs.Fields("Getal1")) = lMatrix(rs.Fields("Getal1")) + 1

Kan dit te maken heb met dat hij voor de 1e 4 rijen niet het aantal dubbelen van de 5 rijen ervoor kan bepalen, omdat deze niet bestaan?

Tevens probeerde ik de code aan ta passen dat hij ook dubbelen tussen de 2 laatste records telt, maar krijg dit niet voor elkaar.
Blijkbaar begrijp ik niet wat je nu precies hebt gedaan.

 

[Elsendoorn2134]

Danny,

Ik zelf krijg de foutmelding niet, maar is het mogelijk dat in je database een lege regel onder aan de tabel
staat? Waardoor "Getal1" een lege cel is of te well een Null?

Dit hele programma is gebaseerd op de controle van vijf regels, als je deze wil aanpassen naar de twee laatste regels

Public Sub TelDubbelen()

Dim db As Database
Dim rs As Recordset
Dim lTeller As Long
Dim nTeller As Integer
Dim nDubbelen As Integer
Dim lMatrix(101) As Long

Set db = CurrentDb()                                              'Gebruik huidige database
Set rs = db.OpenRecordset("Tabel1", dbOpenDynaset)  'Gebruik tabel "Tabel1"
rs.MoveLast                                                          'Ga naar laatste veld voor bepalen aantal records
lTeller = rs.RecordCount                                          'Neem aantal records op
rs.MoveFirst                                                          'Ga naar eerste record

Do While rs.AbsolutePosition <= lTeller - 2                  'Doe zolang het huidige records twee lager is dan aantal records in de tabel 
For nTeller = 1 To 2                                                'Doorloop twee rijen.
        lMatrix(rs.Fields("Getal1")) = lMatrix(rs.Fields("Getal1")) + 1    'Zet het getal in veld "Getal1" in de matrix door deze positie met een te verhogen.
        lMatrix(rs.Fields("Getal2")) = lMatrix(rs.Fields("Getal2")) + 1    'Zet het getal in veld "Getal2" in de matrix .......etc. etc
        lMatrix(rs.Fields("Getal3")) = lMatrix(rs.Fields("Getal3")) + 1
        lMatrix(rs.Fields("Getal4")) = lMatrix(rs.Fields("Getal4")) + 1
        lMatrix(rs.Fields("Getal5")) = lMatrix(rs.Fields("Getal5")) + 1
        rs.MoveNext                                                  'Ga naar het volgende record
    Next
    rs.MovePrevious                                                 'Alle gegevens overgenomen alle dubbelen hebben nu op hun locatie in iMatrix(x) een getal groter dan 1
    nDubbelen = 0                                                   'Oude gegevens verwijderen
    For nTeller = 1 To 100                                         'Doorloop hele matrix
        If lMatrix(nTeller) > 1 Then                               'Als groter dan 1 dan komt het getal meerdere keren voor 
            nDubbelen = nDubbelen + 1                          'Aantal dubbelen tellen
        End If
        lMatrix(nTeller) = 0                                         'Zet IMatrix terug naar 0
    Next                                                                'Volgende nTeller  
    rs.Edit                                                              'Tabel moet worden bijgewerkt dus Edit activeren
    rs.Fields("Dubbelen") = nDubbelen                          'Wijzig het veld dubbelen in het aantal dubbelen.
    rs.Update                                                          'Werk de tabel bij.
Loop                                                                    'Volgende reeks met rijen

MsgBox "Alle dubbelen geteld en in de database gezet.", vbInformation, "Klaar"  'Klaar, dan even afmelden en afsluiten.

End Sub

zou genoeg moeten zijn.

Veel Succes.

 

[OctaFish]

Je kunt natuurlijk veel beter alleen de laatste 5 records openen; het heeft niet zoveel zin om door de complete tabel te lopen als je maar 5 records wilt bekijken. Zelf zou ik dan in ieder geval een Autonummer veld in de tabel zetten, zodat je zeker weet dat je op de laatste 5 records kunt filteren. Daarna is het een kwestie van elk getal in een matrix zetten, en elk veld vergelijken met de in de matrix opgeslagen waarden.

Dim rs As DAO.Recordset, fld As DAO.Field
Dim i As Integer, iDubbel As Integer, iTel As Integer
Dim bChk As Boolean
Dim arr() As Integer
Dim strSQL As String
    strSQL = "SELECT Top 5 Getal1, Getal2, Getal3, Getal4, Getal5 FROM Getallen ORDER BY ID Desc"
    ReDim arr(0)
    Set rs = CurrentDb.OpenRecordset(strSQL)
    iTel = 1
    Do While Not rs.EOF
        For Each fld In rs.Fields
            bChk = False
            For i = LBound(arr) To UBound(arr)
                If fld.Value = arr(i) And UBound(arr) > LBound(arr) Then
                    iDubbel = iDubbel + 1
                    bChk = True
                    Exit For
                End If
            Next i
            If iTel = 1 Then
                arr(UBound(arr)) = fld.Value
            Else
                If bChk = False Then
                    ReDim Preserve arr(UBound(arr) + 1)
                    arr(UBound(arr)) = fld.Value
                End If
            End If
            iTel = iTel + 1
        Next fld
        rs.MoveNext
    Loop
                
    MsgBox iDubbel

 

[OctaFish]

Je kunt het zelfs met een string oplossen; de code wordt dan een stuk korter.

Dim rs As DAO.Recordset, fld As DAO.Field
Dim arr As String
Dim strSQL As String
    
    strSQL = "SELECT Top 5 Getal1, Getal2, Getal3, Getal4, Getal5 FROM Getallen ORDER BY ID Desc"
    Set rs = CurrentDb.OpenRecordset(strSQL)
    iTel = 1
    Do While Not rs.EOF
        For Each fld In rs.Fields
            If InStr(1, arr, "|" & fld.Value & "|") = 0 Then
                If Left(arr, 1) <> "|" Then arr = arr & "|"
                arr = arr & fld.Value & "|"
            Else
                iDubbel = iDubbel + 1
            End If
        Next fld
        rs.MoveNext
    Loop
                
    MsgBox iDubbel