Query gegevens van 1 record naar meerdere records

Status
Niet open voor verdere reacties.
AatB

AatB

Gebruiker
Lid geworden
15 dec 2007
Berichten
253
Geacht forum,

in een tabel met drie velden staan de volgende gegevens;

┌─┬──┬──┐
│A│21│23│
├─┼──┼──┤
│B│19│22│
├─┼──┼──┤
│B│18│19│
└─┴──┴──┘


Nu zoek een manier om middels een query er de volgende gegevens reeks van te maken;


┌─┬──┐
│A│21│
├─┼──┤
│A│22│
├─┼──┤
│A│23│
├─┼──┤
│B│19│
├─┼──┤
│B│20│
├─┼──┤
│B│21│
├─┼──┤
│B│22│
├─┼──┤
│B│18│
├─┼──┤
│B│19│
└─┴──┘


Kunt u mij hierbij helpen?

mvg,

Aat
 
Het heeft even geduurd, maar volgens mij is dit een procedure die zou kunnen werken...

Code: 
Dim dbs As Database
Dim tdfNew As TableDef
     Set dbs = CurrentDB()

     ' Eerst een tijdelijke? tabel maken.
     Set tdfNew = dbs.CreateTableDef("tblTemp")

     On Error Resume Next
     With tdfNew
          .Fields.Append .CreateField("Kolom1", dbText, 10)
          .Fields.Append .CreateField("Kolom2", dbText, 10)
          dbs.TableDefs.Append tdfNew
     End With

     ' Vervolgens de verschillende kolommen van de echte tabel inlezen
     ' en toevoegen aan de tijdelijjke tabel
     strTabel="[Zet hier de tabelnaam]"
     strSQL = "INSERT INTO tblTemp (Kolom1, Kolom2) " & vbCrLf
     iAantalVelden = dbs.TableDefs(strTabel).Fields.Count - 1
     strSQL = strSQL & " SELECT " & dbs.TableDefs(strTabel).Fields(0).Name & " AS Veld1, " 
          For i = 1 To iAantalVelden
               strSQL=""
               strSQL_Temp = strSQL & dbs.TableDefs(strTabel).Fields(i).Name & " AS Veld2 " & vbCrLf
               strSQL_Temp = strSQL_Temp & "FROM " & strTabel 
               DoCmd.RunSQL strSQL_temp
          Next i
      dbs.Close

Er wordt eerst een tijdelijke tabel aangemaakt, en daarna wordt in de tabel met de voor elk veld steeds een query gemaakt met het eerste veld, en een opvolgend veld. Vervolgens wordt deze combinatie met een Insert query toegevoegd aan de tijdelijke tabel.
Je kunt deze code onder een knop zetten, en wel uiteraard eerst de tabelnamen fatsoeneren...

Misschien moet je nog wat aanpassen, want ik heb hem eerlijk gezegd nog excessief goed uitgetest. Kan dus zijn, dat hij nog niet gelijk werkt....
Ben eigenlijk ook maar een mens :)
 
Laatst bewerkt:
OctaFish zei:
Het heeft even geduurd, maar volgens mij is dit een procedure die zou kunnen werken...

Code: 
Dim dbs As Database
Dim tdfNew As TableDef
     Set dbs = CurrentDB()

     ' Eerst een tijdelijke? tabel maken.
     Set tdfNew = dbs.CreateTableDef("tblTemp")

     On Error Resume Next
     With tdfNew
          .Fields.Append .CreateField("Kolom1", dbText, 10)
          .Fields.Append .CreateField("Kolom2", dbText, 10)
          dbs.TableDefs.Append tdfNew
     End With

     ' Vervolgens de verschillende kolommen van de echte tabel inlezen
     ' en toevoegen aan de tijdelijjke tabel
     strTabel="[Zet hier de tabelnaam]"
     strSQL = "INSERT INTO tblTemp (Kolom1, Kolom2) " & vbCrLf
     iAantalVelden = dbs.TableDefs(strTabel).Fields.Count - 1
     strSQL = strSQL & " SELECT " & dbs.TableDefs(strTabel).Fields(0).Name & " AS Veld1, " 
          For i = 1 To iAantalVelden
               strSQL=""
               strSQL_Temp = strSQL & dbs.TableDefs(strTabel).Fields(i).Name & " AS Veld2 " & vbCrLf
               strSQL_Temp = strSQL_Temp & "FROM " & strTabel 
               DoCmd.RunSQL strSQL_temp
          Next i
      dbs.Close

Er wordt eerst een tijdelijke tabel aangemaakt, en daarna wordt in de tabel met de voor elk veld steeds een query gemaakt met het eerste veld, en een opvolgend veld. Vervolgens wordt deze combinatie met een Insert query toegevoegd aan de tijdelijke tabel.
Je kunt deze code onder een knop zetten, en wel uiteraard eerst de tabelnamen fatsoeneren...

Misschien moet je nog wat aanpassen, want ik heb hem eerlijk gezegd nog excessief goed uitgetest. Kan dus zijn, dat hij nog niet gelijk werkt....
Ben eigenlijk ook maar een mens :)
Klik om te vergroten...

Hi Michel,

het werken met een tijdelijke tabel vind ik een goed idee.

Het zou dan als volgt moeten werken;

Code: 
table1 bevat de gegevens

for n1 = 1 to eof of table1
   read record(n)
     for n2 = veld2 to veld3 (in het eerste record zijn dit 23 & 24)
        write to tabletemp (veld1.table1 (in het eerste record is dit A), n2)
     next
next

Ik heb geen idee hoe ik dit moet maken in VBA.
Kun jij mij hierbij helpen?
Dat zou super zijn.


Bedankt alvast.....

mvg,

Aat
 
Niet om het een of ander, maar heb je mijn routine al uitgetest?
Die doet namelijk precies wat je vraagt...
 
Leuk probleem!
Ik hoop dat ik me hier ook even mee mag bemoeien.

@Octafish:
Het is goed om te zien dat je een mens bent!
Ik was al bang dat je een autoreply functie was van HelpMij... :p
Dit bedoel ik overigens als een compliment. ;)

Er staat in de code:
strSQL=""
Dit gaat nooit werken. Dit had strSQL_Temp = "" moeten zijn.

Tevens wil Aat ook de tabel aanvullen met gegevens die niet in de brontabel staan (A 22, B 20 en B 21).
@Aat: Toch?
Kortom kopiëren van de tabel is waarschijnlijk niet voldoende.
Neemt niet weg dat het een mooi stukje code is! ;)

@Aatb:
Ik heb even een voorbeeldje gemaakt die de volgende 2 dingen doet:
1) tabel kopiëren (van Octafish).
2) tabel aanvullen (o.a.: A 22, B 20 en B 21).

Met bijbehorende knoppen op Formulier1:
- Tabel kopiëren (code van Octafish)
- Tabel aanvullen

Let wel:
1) De 1e keer dat je de code runt is er in jouw db nog geen TblTemp1.
Dus dbs.Execute "DROP TABLE TblTemp1" werkt dan niet!

2) De velden in de brontabel moeten gevuld zijn!
Ivm rst.Fields(0) t/m rst.Fields(2).

De code is als volgt:
Code: 
Dim dbs As Database
Dim rst As Recordset

Dim strTabel As String
Dim strSql As String
Dim strSQL_temp As String
Dim sWaarde As String

Dim iMin As Integer
Dim iMax As Integer
Dim iAantal As Integer
Dim i As Integer

    Set dbs = CurrentDb()
    'Naam van de brontabel aanpassen
    strTabel = "Tblgegevens"
    
    'Eerst de tijdelijke tabel verwijderen en maken.
    dbs.Execute "DROP TABLE TblTemp1"  'Uitzetten bij db, zonder TblTemp1
    dbs.Execute "CREATE TABLE TblTemp1(Kolom1 Char(1), Kolom2 Integer);"
    
    'Gegevens ophalen uit tabel en tabel tblTemp1 invullen
    Set rst = CurrentDb.OpenRecordset("Select * from " & strTabel)
    Do Until rst.EOF
        'Kolommen 1, 2 en 3 ophalen
        sWaarde = rst.Fields(0)
        iMin = rst.Fields(1)
        iMax = rst.Fields(2)
        iAantal = iMax - iMin + 1
        
        strSql = "INSERT INTO tblTemp1 (Kolom1, Kolom2) "
        
        'Lus tot de iAantal is bereikt
        For i = 1 To iAantal
            strSQL_temp = ""
            strSQL_temp = strSql & "VALUES('" & sWaarde & "', '" & iMin & "') "
            CurrentDb.Execute strSQL_temp
            
            iMin = iMin + 1
        Next i
        
        rst.MoveNext
    Loop
    
    rst.Close
    dbs.Close
    Set rst = Nothing
    Set dbs = Nothing
    
    'Tabel openen
    DoCmd.OpenTable "tblTemp1"
    'refresh Databasewindow is nodig als er nog geen TblTemp1 is
    'Application.RefreshDatabaseWindow


Waarschijnlijk heb ik ook ook nog wel wat foutjes gemaakt, maar ik ben ook maar een mens! Tevens ben ik ook niet zo ervaren als Octafish of anderen op dit forum...
Ik hoop in elk geval dat je een stap dichterbij de oplossing bent.
 

Bijlagen

  • TblTemp.zip
    15,2 KB · Weergaven: 17
Greenery80 zei:
Leuk probleem!
Ik hoop dat ik me hier ook even mee mag bemoeien.

@Octafish:
Het is goed om te zien dat je een mens bent!
Ik was al bang dat je een autoreply functie was van HelpMij... :p
Dit bedoel ik overigens als een compliment. ;)

Er staat in de code:
strSQL=""
Dit gaat nooit werken. Dit had strSQL_Temp = "" moeten zijn.

Tevens wil Aat ook de tabel aanvullen met gegevens die niet in de brontabel staan (A 22, B 20 en B 21).
@Aat: Toch?
Kortom kopiëren van de tabel is waarschijnlijk niet voldoende.
Neemt niet weg dat het een mooi stukje code is! ;)

@Aatb:
Ik heb even een voorbeeldje gemaakt die de volgende 2 dingen doet:
1) tabel kopiëren (van Octafish).
2) tabel aanvullen (o.a.: A 22, B 20 en B 21).

Met bijbehorende knoppen op Formulier1:
- Tabel kopiëren (code van Octafish)
- Tabel aanvullen

Let wel:
1) De 1e keer dat je de code runt is er in jouw db nog geen TblTemp1.
Dus dbs.Execute "DROP TABLE TblTemp1" werkt dan niet!

2) De velden in de brontabel moeten gevuld zijn!
Ivm rst.Fields(0) t/m rst.Fields(2).

De code is als volgt:
Code: 
Dim dbs As Database
Dim rst As Recordset

Dim strTabel As String
Dim strSql As String
Dim strSQL_temp As String
Dim sWaarde As String

Dim iMin As Integer
Dim iMax As Integer
Dim iAantal As Integer
Dim i As Integer

    Set dbs = CurrentDb()
    'Naam van de brontabel aanpassen
    strTabel = "Tblgegevens"
    
    'Eerst de tijdelijke tabel verwijderen en maken.
    dbs.Execute "DROP TABLE TblTemp1"  'Uitzetten bij db, zonder TblTemp1
    dbs.Execute "CREATE TABLE TblTemp1(Kolom1 Char(1), Kolom2 Integer);"
    
    'Gegevens ophalen uit tabel en tabel tblTemp1 invullen
    Set rst = CurrentDb.OpenRecordset("Select * from " & strTabel)
    Do Until rst.EOF
        'Kolommen 1, 2 en 3 ophalen
        sWaarde = rst.Fields(0)
        iMin = rst.Fields(1)
        iMax = rst.Fields(2)
        iAantal = iMax - iMin + 1
        
        strSql = "INSERT INTO tblTemp1 (Kolom1, Kolom2) "
        
        'Lus tot de iAantal is bereikt
        For i = 1 To iAantal
            strSQL_temp = ""
            strSQL_temp = strSql & "VALUES('" & sWaarde & "', '" & iMin & "') "
            CurrentDb.Execute strSQL_temp
            
            iMin = iMin + 1
        Next i
        
        rst.MoveNext
    Loop
    
    rst.Close
    dbs.Close
    Set rst = Nothing
    Set dbs = Nothing
    
    'Tabel openen
    DoCmd.OpenTable "tblTemp1"
    'refresh Databasewindow is nodig als er nog geen TblTemp1 is
    'Application.RefreshDatabaseWindow


Waarschijnlijk heb ik ook ook nog wel wat foutjes gemaakt, maar ik ben ook maar een mens! Tevens ben ik ook niet zo ervaren als Octafish of anderen op dit forum...
Ik hoop in elk geval dat je een stap dichterbij de oplossing bent.
Klik om te vergroten...

Bedankt voor jullie info en ik ga een en ander vanavond even uit proberen.

Ik hou jullie op de hoogte....


mvg,

Aat
 
AatB zei:
Bedankt voor jullie info en ik ga een en ander vanavond even uit proberen.

Ik hou jullie op de hoogte....


mvg,

Aat
Klik om te vergroten...

Het werkt.... prima oplossing.
Bedankt allebei.

mvg,

Aat
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan