Een "platte" database maken...

[assessor]

Voorbeeld:

Ik krijg regelmatig een enorme lijst met data aangeleverd, deze lijst bevat in kolom 1 "artikel" en in kolom 2 "kleur".

Voor een artikel in tien kleuren heb ik dus in kolom 1 10x dezelfde artikel-naam en als het volgende artikel in 25 kleuren wordt uitgevoerd zit ik al op 35 regels terwijl dit op twee regels kan. Ik wil dit om kunnen zetten in één kolom voor het artikel en verder ook voor elke kleur een kolom waarin ik "ja/nee'" kan aangeven. Ik denk dat ik met iets als "select-case" of "if, then, else" aan de gang moet maar ik ben nog te groen in VB en heb een duwtje in de goede richting nodig.

Wie kan mij hieraan helpen?

Grts, assessor

 

[vanzwam]

Je maakt een tabel met volgende velden.

1 ArtikelID -> autonummering -> primaire sleutel
2 Artikel -> tekst of numeriek
3 Kleur 1 -> Ja/Nee
4 Kleur 2 -> Ja/Nee
.....
......

Nu maak je een formulier. en sleep de tabelvelden naar uw formulier. Je kan nu bij elk artikel een kleur aanvinken. Wil je daar nog bewerkingen mee kunnen doen? Dan heb je toch al een basis nu.

 

[assessor]

Ik denk dat ik niet duidelijk genoeg ben geweest.
Mijn database werkt alleen met bestaande tabellen uit 4 andere databases.
Ik maak zelf geen tabellen, totaal geen input, slechts query's. (Eigen input is een "NO")
(artikel en kleur heb ik slechts als voorbeeld genomen om de bedoeling duidelijk te maken)
De tabellen tellen duizenden regels, wijzigen constant en worden zodoende regelmatig ge-update d.m.v. macro's.

Ik moet deze specifieke tabel dus inderdaad omzetten, maar die "vinkjes" die moeten er automatisch komen dit is manueel niet te doen.

Deze code doet dit in Excel, ik moet dit zogezegd vertalen in Access

Sub transform()
' Haal alle unieke certificaatomschrijvingen op.
' Gebruik hiervoor de 'cert_kolom' + 2 dus één kolom overslaan
' de tussenliggende kolom moet leeg zijn.

On Error GoTo fout_opgetreden

Application.ScreenUpdating = False
Set sht1 = ThisWorkbook.Worksheets("Result")
Set sht_src = ThisWorkbook.Worksheets("Source_data")
sht_src.Cells(1, 1).CurrentRegion.Copy Destination:=sht1.Cells(1, 1)

Range(sht1.Cells(1, cert_kolom + 1), sht1.Cells(65536, 255)).Clear 'alle kolommen vanaf "cert_kolom" leeg maken
sht1.Cells(1, 1).CurrentRegion.Sort Key1:=sht1.Cells(2, 1), Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
sht1.Cells(1, cert_kolom + 2) = sht1.Cells(1, cert_kolom)
aant_rijen = sht1.Cells(1, cert_kolom).CurrentRegion.Rows.Count

' Filter unique
Range(sht1.Cells(1, cert_kolom), sht1.Cells(aant_rijen, cert_kolom)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=sht1.Cells(1, cert_kolom + 2), CriteriaRange:="", Unique:=True

' Sorteren
sht1.Cells(1, cert_kolom + 2).CurrentRegion.Sort Key1:=sht1.Cells(2, cert_kolom + 2), Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

certificates = sht1.Cells(1, cert_kolom + 2).CurrentRegion
sht1.Columns(cert_kolom + 2).Clear

For n = 2 To UBound(certificates)
    sht1.Cells(1, cert_kolom + n - 1) = certificates(n, 1)
Next n
With sht1.Rows("1:1")
    .EntireRow.AutoFit
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .WrapText = False
    .Orientation = 90
    .MergeCells = False
End With
sht1.Columns.AutoFit
counter = 2

Do Until sht1.Cells(counter, 1) = ""
    naam = sht1.Cells(counter, 1)
    naam_regel = counter
    Do While sht1.Cells(counter, 1) = naam
        cert = sht1.Cells(counter, cert_kolom)
        For n = 2 To UBound(certificates)
            If cert = certificates(n, 1) Then
                sht1.Cells(naam_regel, cert_kolom + n - 1) = "X"
                If counter <> naam_regel Then
                    sht1.Cells(counter, 1).EntireRow.Delete
                Else
                    sht1.Cells(counter, cert_kolom).Clear
                    counter = counter + 1
                End If
                Exit For
            End If
        Next n
        
    Loop
Loop
sht1.Columns(cert_kolom).Delete
Application.ScreenUpdating = True

Exit Sub

fout_opgetreden:
Application.ScreenUpdating = True
MsgBox "Er is een fout opgetreden."
End Sub

alvast mijn dank.

 

[assessor]

Deze vraag is wellicht wat te gecompliceerd om simpel te vragen/beantwoorden, aan een ieder die de moeite heeft genomen om er naar te kijken mijn dank.

groet, assessor

 

[Bartuls]

Je vraag is niet echt gecompliceerd hoor.
Alleen kost het veel tijd om een duidelijk antwoord te geven als je de mdb niet beschikbaar stelt. Iemand die dan een antwoord wil geven moet eerst zelf tabellen met gegevens gaan maken en vervolgens kijken wat de beste oplossing is.
Post je mdb even, ik weet zeker dat je dan een antwoord krijgt.

 

[assessor]

Elders in dit forum ben ik al door een paar "deelproblemen" heen geholpen.

De code zoals deze hier staat werkt in Excel dit ga ik met de nodige aanpassingen in Access ook werkend krijgen. Tot dan doe ik dit gedeelte maar met Excel.

Wat mij gelijk op een nieuwe vraag brengt die ik hier ga stellen zodra ik wat heb rondgesnuffeld om te kijken of deze niet al eens is gesteld.

Allen bedankt,

assessor