records x-keer bijvoegen in tabel

[mdegeest]

Kan er mij iemand helpen om het volgende probleem op te lossen :
Ik heb een bestand waarin verschillende records staan. (klantnummer, naam, rijnummer, aantal)
bv : klantnummer = 865 , naam = jacobs ; rijnummer = 120 , aantal = 5
Wanneer aantal > 1, dan moet het record (in dit voorbeel 4 keer) toegevoegd worden aan de tabel.
Omdat aantal = 5 moet mijn record 5 keer weg geschreven worden in de tabel met rijnummer telkens + 1
Als aantal maar 1 is, dan moet er niets gebeuren omdat het record slechts 1 keer in de tabel moet staan.
Ik zou dit willen doen via een stukje vba code maar ik ben hier geen primus in.
Kan mij iemand helpen aub.
Enkel het rijnummer wijzigt steeds, rest van de velden moet enkel gecopieerd worden.

 

[OctaFish]

Dat riekt als een tabel met enige dataredundantie, dus ik zou dat zeker anders oplossen als ik jou was. In ieder geval kan het veld Naam eruit, want dat staat als het goed is (samen met je klantnummer) al in je tabel Klanten.

 

[OctaFish]

Het principe kun je hier wel uithalen, maar je kunt de code niet zonder meer uitvoeren, omdat hij oneindig vaak doorloopt. Als je in dezelfde tabel als die je uitleest records toevoegt, worden die ook weer gebruikt als bron, en het gevolg is dus dat er geen einde komt aan de recordset. Dus daar moet je nog iets op verzinnen. (Tip: tel eerst het aantal records in de oorspronkelijke recordset, en gebruik dat als stoppunt voor de toevoeglus)

Sub X2()
Dim strSQL As String
Dim i As Integer, iAantal As Integer, iKlantNr As Integer, iRijnr As Integer
Dim rs As DAO.Recordset, rsA As DAO.Recordset

strSQL = "SELECT Klantnummer, Rijnummer, Aantal FROM MyTable WHERE [Aantal] >1"
Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
    Do While Not .EOF
        iKlantNr = !Klantnummer
        iRijnr = !Rijnummer
        iAantal = !Aantal
            For i = 1 To iAantal - 1
                .AddNew
                !Klantnummer = iKlantNr
                !Rijnummer = iRijnr + i
                !Aantal = iAantal
                .Update
            Next i
        .MoveNext
    Loop
End With
End Sub

 

[mdegeest]

Dank voor de hulp.
Records worden bijgevoegd. :thumb: