Verzamelstaat maken uit een tabel

[oceanrace]

Goedendag Helden,

Ik ben op zoek naar een formule om een verzamelstaat te maken met gegevens uit een tabel.
In de bijlage zit een voorbeeld met uitleg.
Wie kan me helpen?

 

[Cobbe]

Helpt deze u vooruit?

=ALS(I$3="";"";INDEX($A$15:$AC$400;VERGELIJKEN($H3;$A$15:$A$400;0);VERGELIJKEN(I$3;$A$15:$AC$15;0)))

 

[oceanrace]

Bedankt Cobbe,
Deze formule is goed om de tarieven op te zoeken (rij met EUR teken ervoor), echter niet alle kolommen hebben tarieven.
Ik zoek dus telkens de eerstvolgende kolom waarbij een tarief is gevuld, met daaronder het tarief.

 

[Cobbe]

Kan je hier iets mee?
Klik dubbel op een waarde in kolom A (vanaf A16) en zie of je er iets aan hebt.

 

[oceanrace]

Hoi Cobbe,
Dat is wel heel creatief bedacht, gewoon de kolommen laten verdwijnen die leeg zijn. Haha, mooi.
Maar niet wat ik bedoel, ik moet namelijk een verzamelstaat maken van 3 zoeksleutels om te vergelijken.

 

[Leotaxi]

Dag Bas,

kan deze je vooruit helpen

mvg
Leo

 

[oceanrace]

Hallo Leo,
Bedankt voor je hulp, dat is wat ik zoek.
Cobbe ook bedankt!
Wat een geweldig forum is dit toch!

 

[oceanrace]

Toch nog een vraag, de VBA oplossing van Leo werkt uitstekend.
Maar zou het ook als Function gebouwd kunnen worden, zodat ik niet telkens op de macroknop hoef te drukken als er nieuwe zoeksleutels gevuld worden?

 

[Leotaxi]

Dag Bas,

zal zeker mogelijk zijn, maar zelf ben ik zover nog niet
dus dat is voor de specialisten.

mvg
Leo

 

[VenA]

Dit kan met het Worksheet_Change event.

De code plaatsen onder blad1

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("H3,H5,H7,H9")) Is Nothing Then
    Macro1
    Target.Select
End If
End Sub

Als je iets wijzigt in de cellen H3,H5,H7 of H9 zal de code van Leotaxi aangeroepen worden.

 

[oceanrace]

Bedankt, ik ga het proberen!

 

[Leotaxi]

Bas,

in vorige versie toch een foutje (keek naar waardes per 2 kolommen ) dat hierbij verbeterd is
en door tip van VenA tevens zonder knop.

mvg

Leo

 

[oceanrace]

Hoi Leo / VenA / Cobbe,
Super, nu werkt het precies zoals ik bedoelde.
De waarden worden automatisch gevuld zonder op een knop te drukken.

 

[snb]

Die aanpak lijkt me niet voor de hand liggend.

Gebruik de gebeurtenis 'change' ipv 'selection_change'.
Vermijd 'Select' en 'Activate' in VBA
Vermijd het herhaaldelijk lezen/schrijven uit/naar een werkblad.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("H3,H5,H7,H9")) Is Nothing Then
        sn = Blad1.Cells(15, 1).CurrentRegion.Resize(, 29)
        Range("I3:R10").ClearContents
        sp = Range("I3:R10")
        
        For j = 1 To 4
           If Cells(1 + 2 * j, 8) <> "" Then
                r = 1
                y = Application.Match(Cells(1 + 2 * j, 8), Application.Index(sn, , 1), 0)
                
                For jj = 2 To UBound(sn, 2)
                   If sn(y, jj) <> "" Then
                     sp(2 * (j - 1) + 1, r) = sn(1, jj)
                     sp(2 * (j - 1) + 2, r) = sn(y, jj)
                     r = r + 1
                   End If
                Next
           End If
        Next
        
        Range("I3:R10") = sp
    End If
End Sub

 

[Leotaxi]

@ SNB

inderdaad vele keren beter maar dat had ikzelf nog niet gekund
maar ben wel blij weer bijgeleerd te hebben

@ Bas

neem die maar over, is zeker sneller, en het gebruik van cellen c8 en c9 is ook van de baan.

mvg
Leo

 

[oceanrace]

Bedankt voor de verbetering SNB, ik ga deze overnemen.
Zo leren we allemaal weer wat bij

 

[oceanrace]

Nog even een reactie, het lijkt erop of de Change gebeurtenis van SNB alleen werkt wanneer je harde waardes als zoeksleutel inklopt.
Bij de oplossing van Leo werkt het ook wanneer de zoeksleutel in formulevorm wordt gevuld (celverwijzing naar ander blad).
Kan dat kloppen?

 

[Leotaxi]

Bas,

zoals reeds eerder gezegd, mijn kennis van vba is nog maar 0,1 %
misschien doordat ik mijn macro de zoeksleutel tijdelijk verhuis naar C8 dat hij het wel doet.
maar zoals al aangegeven, het blijft een ongebruikelijke oplossing maar ik kan er geen andere leveren.

mvg

Leo