Access VBA Unique Values

[Gerard_46]

Ik heb een Access database met twee velden. 1) Aanvragerr 2)Gebruikte Opties_Groep.
A 1
A 2
B 1
C 1
D 3
E 1
E 1
E 2

De VBA module loopt door de tabel en schrijft de gegevens als volgt weg in een nieuwe tabel.

A 1,2
B 1
C 1
D 3
E 1,1,2

Bij diverse regels zijn er echter dubbele waarden (zoals bij E)

Hoe kan ik de module aanpassen zodat, bij E in dit voorbeeld, het volgende ontstaat?

E 1,2

 

[OctaFish]

Dan hebben we de code nodig die je nu gebruikt.

 

[Gerard_46]

Option Compare Database
Public teller As Integer
Public Aanvrager As String
Public GroepNr As String
Public Opties As String

Public Function categorie()

Set rs = CurrentDb.OpenRecordset("Select * from Explain_Tabel")
rs.Sort = "[Aanvr_nr], [Explaingroep]"
Set rs0 = rs.OpenRecordset

' Lees eerste record in
rs0.MoveFirst
Aanvrager = rs0.[Aanvr_nr]
Opties = rs0.[Explaingroep]

'Ga naar volgend record
rs0.MoveNext


Do Until rs0.EOF

'Als aanvraagnr 1e record (on)gelijk aan aanvraagnr 2e record dan ...
If rs0.[Aanvr_nr] <> Aanvrager Then

'wegschrijven waarde variabelen in nieuwe tabel
Schrijven
'Variabelen opnieuw inlezen
Opties = rs0.[Explaingroep]
Aanvrager = rs0.[Aanvr_nr]

Else
'Variabele uitbreiden indien aanvraagnummers identiek zijn
Opties = Opties & "," & rs0.[Explaingroep]

End If

rs0.MoveNext

Loop

Set rs = Nothing

End Function

Public Function Schrijven()

Set rs1 = CurrentDb.OpenRecordset("Rap_Tabel_Explains")


'schrijf new record met aanvraagnr en gebruikte explainredenen
rs1.AddNew
rs1.[Aanvr_nr] = Aanvrager
rs1.Cat = Opties
rs1.Update

rs1.Close

End Function

 

[OctaFish]

Zou je de code nog even willen opmaken met de Code knop ( knop met [ # ])? Dat maakt hem een stuk leesbaarder... Kijk ik ondertussen even naar de code!

 

[OctaFish]

Je kunt de hele procedure terugbrengen tot één functie:

Public Function Categorie()

    With CurrentDb.OpenRecordset("SELECT DISTINCT [Aanvr_nr],[Explaingroep] " _
        & "FROM Explain_Tabel " _
        & "ORDER BY [Aanvr_nr], [Explaingroep]")
        .MoveFirst
        Do While Not .EOF
            With CurrentDb.OpenRecordset("Rap_Tabel_Explains")
                .AddNew
                ![Aanvr_nr] = ![Aanvr_nr]
                !Cat = ![Explaingroep]
                .Update
                .Close
            End With
            .MoveNext
        Loop
    End With

End Function

Om te beginnen: een aanpassing in je query. Niet meer alle records, maar met DISTINCT de unieke. Dan moet je wel alleen de velden ophalen die je nodig hebt, en niet meer het * teken gebruiken.
Verder kun je de sortering ook al in de query doen met ORDER BY, dus dat scheelt weer een extra recordset.
En omdat je alleen de unieke records uitleest, kun je ze gelijk wegschrijven; dat scheelt een extra functie.

 

[Gerard_46]

Michel.

Ik weet niet wat je bedoelt met de opmaak van de module?
Ik kan de hele module exporteren en je toezenden als dat enigszins kan helpen.

Gerard

 

[OctaFish]

Ik heb het volgens mij niet over een module gehad? Wat ik bedoelde was dat je grote lappen VBA code het beste kunt opmaken met de Code knop; dan ziet-ie er een stuk leesbaarder uit, zoals bij mijn code. Heb je de nieuwe code al uitgeprobeerd?

 

[Gerard_46]

Ga ik vanavond doen, moet nu dringend andere werkzaamheden uitvoeren. Alvast bedankt voor je moeite.

Gerard

 

[Gerard_46]

Michel,

Module geeft foutmelding
![Aanvr_nr] = ![Aanvr_nr] blijft Null
!Cat = ![Explaingroep] kan element niet terugvinden in de collectie

Gerard

 

[OctaFish]

Ik heb 'm uitgetest op een paar tabellen met exact deze tabel- en veldnamen en hij deed het prima. Vandaar dat ik 'm zo heb gepost. Ik vermoed dat je veldinstellingen in je tabel anders zijn, maar daarvoor zou ik een voorbeeldje moeten zien.

 

[Gerard_46]

OK. Ik ga nog wat testen en uitproberen en meld je de resultaten.
Gerard

 

[Gerard_46]

Michel,

De code is werkend. alleen is dit niet het resultaat dat ik wil bereiken.
Ik heb nu unieke records met nummer/groep.
Aanvr_nr Expl_Groep
1231861 1
1231861 4
1231861 5

Wat ik wil bereiken is dat de deze data als volgt in 1 record komt vast te liggen.

Aanvr_nr Expl_Groep
31861 1,4,5

Kan dit met een soortgelijke module of zal ik mijn originele versie gebruiken?

Gerard

 

[OctaFish]

Dan krijg je zoiets:

Public Function Categorie()
Dim strSQL As String, sCat As String, sAanvr As String
Dim rs As DAO.Recordset
Dim bStart As Boolean

    strSQL = "SELECT DISTINCT Aanvr_nr, Explaingroep " _
        & "FROM Explain_Tabel " _
        & "ORDER BY Aanvr_nr, Explaingroep;"
    
    Set rs = CurrentDb.OpenRecordset(strSQL)
    With rs
        .MoveFirst
        Do While Not rs.EOF
            If sAanvr = "" Or sAanvr = !Aanvr_nr Then
                sAanvr = !Aanvr_nr
                If sCat & "" <> "" Then sCat = sCat & ","
                sCat = sCat & rs!Explaingroep
            Else
                bStart = True
            End If
            If bStart = True Then
                With CurrentDb.OpenRecordset("Rap_Tabel_Explains")
                    .AddNew
                    ![Aanvr_nr] = sAanvr
                    !Cat = sCat
                    .Update
                    .Close
                End With
                sAanvr = !Aanvr_nr
                sCat = !Explaingroep
                bStart = False
            End If
        .MoveNext
        Loop
        With CurrentDb.OpenRecordset("Rap_Tabel_Explains")
            .AddNew
            ![Aanvr_nr] = sAanvr
            !Cat = sCat
            .Update
            .Close
        End With
    End With
    
End Function

 

[Gerard_46]

Michel,

Heb je code nog iets aangepast, zodat nu het gewenste resultaat bereikt wordt.
Dank voor je tips.

Gerard

Option Compare Database

Public Function Categorie()
Dim strSQL As String, sCat As String, sAanvr As String
Dim rs As DAO.Recordset

strSQL = "SELECT DISTINCT [Aanvr_nr],[Expl_groep] " _
& "FROM Tbl_Aanvrager_Explains " _
& "ORDER BY [Aanvr_nr], [Expl_groep]"

Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
.MoveFirst
sCat = !Expl_groep
sAanvr = !Aanvr_nr
.MoveNext
Do While Not rs.EOF

If sAanvr = !Aanvr_nr Then
sCat = sCat & "," & rs!Expl_groep
Else

With CurrentDb.OpenRecordset("Rap_Tabel_Explains")
.AddNew
![Aanvr_nr] = sAanvr
![Expl_groep] = sCat
.Update
.Close
sCat = ""
sAanvr = ""
End With
sAanvr = rs![Aanvr_nr]
sCat = !Expl_groep
End If
.MoveNext
Loop
End With

End Function