VBA gebruiken om ledenlijst om te zetten naar een teamindeling

[Vridos]

Ik wil filteren uit een ledenlijst. Deze moeten in de juiste teams geplaatst worden.
Eerst heb ik de betreffende teams uit dezelfde lijst gefilterd en op volgorde gezet. (Zie fotobijlage)
Nu wil ik deze teamselectie gebruiken om de teams samen te voegen op 1 werkblad “Teams+Scheidsrechters”
De gegevens voor de positie op dat blad komen uit een andere werkblad “Info”. (A2, C2, D2 en A3, C3, D3 etc)
De te filteren lijst staat op werkblad “Ledenlijst”
Op deze manier moet de hele lijst uit kolom “A” worden doorlopen en na het laatste team stoppen.
Het aantal teams kan variëren.
Ik ben aan het zoeken hoe ik dit moet doen, maar kan er niet uitkomen.
De eerste 2 regels zijn mijn poging om de 1e variabele op te vragen, maar dat moet simpeler kunnen, denk ik.
Onderstaande code werkt zoals ik het graag zou willen, alleen heb ik daar handmatig de cellen ingevuld.
Deze heb ik nu vervangen door de benamingen welke ik hiervoor zou willen gebruiken.

Sub Teams_verdelen_test()

' Teamleden verdelen over beschikbare teams, variabelen Team, Teamnaam,Teamlid

Sheets("Info").Select
Range(“Team”).Copy
Sheets("Teams+Scheidsrechters").Select
Range(“Teamnaam”).PasteSpecial
Sheets("Ledenlijst").Select
ActiveSheet.Range("$A$1:$M$132").AutoFilter Field:=11
ActiveSheet.Range("$A$1:$M$132").AutoFilter Field:=11, Criteria1:=”Team”
Range("B2:B125,M2:M125").Copy
Sheets("Teams+Scheidsrechters").Select
Range(“Teamlid”).PasteSpecial

End Sub



Ik hoop dat jullie me verder kunnen helpen.

Mvg Paul

 

[Mde]

welkom op het forum.

met een voorbeeldbestand excel word je beter geholpen

 

[Vridos]

Excel voorbeeld toegevoegd

Mde bedankt en bedankt voor je opmerking.
Ik heb een voorbeeld aangemaakt en toegevoegd

 

[Mde]

Snap niet precies wat je wilt.
Je zou het ook met een draaitabel kunnen doen samen met een slicer.

 

[Vridos]

Beste Mde,

Wat jij voorstelt is een mogelijkheid, maar niet wat ik voor ogen heb.
Ik ben een gebruiker van excel, maar met een nieuwsgierige inslag, dus weet niet veel van excel en VBA.
Wat ik nu heb is door veel zoeken en macro's opnemen gelukt.
Alleen dit laatste lukt me niet.

Deze lijst moet in 1 oog opslag aanbieden wie in welk team zit en welke fluitlicentie heeft.
Ik heb het voorbeeld verder handmatig uitgebreid met hoe ik het voor me zie.
Maar omdat handmatig fouten in de hand werkt zou ik dit automatisch willen doen.
En deze lijst wordt waarschijnlijk meermalen per seizoen geupdate.

Mvg Paul

 

[VenA]

Beetje onduidelijk allemaal. Je hebt 7 teams? (Blad info kolom A). Je hebt 22 teamnamen? (Blad info kolom C) en dan heb je nog 29 teamnamen? (Blad info kolom F). De opgenomen macro's zijn 1 grote flipperkast waar ook niet veel uit duidelijk wordt. Kolomkoppen als 'vrij veld x' zijn ook niet echt helder. Waarom je zo'n rommelig opzet in de tab 'Teams+Scheidsrechters' wil kan ik ook niet echt vinden. Waar de fluitlicenties zijn is volgens mij ook nergens te vinden.

Maak een helder voorbeeld bestand zonder overbodige code met alleen de essentie van wat je hebt en waar je naar toe wil.

 

[Vridos]

Dank voor uw reactie en opmerkingen VenA.
Dit is de eerste keer dat ik om raad vraag en niet weet wat ik wel en niet mee moet sturen.

Die onduidelijkheid komt omdat ik een gedeelte van mijn volledige file geüpload heb.
En de rommelige opzet komt omdat ik met persoonsgegevens moet werken en deze hier niet kan vrij geven.

Ik heb nu de file opgeruimd.
De teamnamen waar het om gaat staan op tab "Info" in kolom A, gevolgd door locaties waar ik de gegevens wil plaatsen.
Eigenlijk komt het er in het kort op neer, dat ik de gegevens (kolommen B-K-M) van tab "Ledenlijst" wil omzetten naar tab "Teams+Scheidsrechters", met de namen en locaties van tab "Info".
Hoop dat jullie me toch nog verder willen/kunnen helpen.

Mvg Paul

 

[VenA]

Is dit voorbeeld representatief? Je hebt nu geen headers meer in het blad 'Ledenlijst'. De fluitlicenties kan ik ook nog steeds niet vinden.

 

[Vridos]

Deze lijst is representatief, behalve dat de filters in blad "Ledenlijst" ook weggegooid zijn.
De 'Headers' heb ik een lege regel van gemaakt omdat deze niet terzake doen.
Deze kunnen wel eens wijzigen.
De kreet 'fluitlicenties' waar ik voorheen over schreef staan in kolom M.

Het gaat dus alleen hierom:
-De teamnamen waar het om gaat staan op tab "Info" in kolom A, gevolgd door locaties waar ik de gegevens wil plaatsen.
-Eigenlijk komt het er in het kort op neer, dat ik de gegevens (kolommen B-K-M) van tab "Ledenlijst" wil omzetten naar tab "Teams+Scheidsrechters", met de namen en locaties van tab "Info".

Mvg Paul

 

[JEC.]

Ik kan er nog steeds geen touw aan vastknopen:shocked:

 

[popipipo]

Een draaitabel is een ideale oplossing voor dit probleem

 

[VenA]

De 'Headers' heb ik een lege regel van gemaakt omdat deze niet terzake doen.

Lijkt mij een gedachte van totale onkunde. Kopteksten hebben oa het nut van dat je weet welke gegevens in welke kolom staan. Filteren, sorteren en nog veel meer werkt veel eenvoudiger als je gebruik maakt van kopteksten. Ik zou de nieuwsgierige inslag gebruiken om eerst wat basiskennis tot je te nemen ipv gelijk in het diepe te willen springen.

 

[JEC.]

Het wordt er niet simpeler/sneller op maar deze doet denk ik precies wat je vraagt. Toch zou ik je bestand helemaal omgooien.

Voor in je voorbeeldbestand van post #7
Ps: zet op je laatste tabblad eerst even de cellen om.

A1 naar A2
A2 naar A3
F15 naar F16
F16 naar F17
etc... dan klopt het beter

Sub jvrr()
   Set jv = Sheets(2).Cells(2, 1).CurrentRegion
   Set jv2 = Sheets(3).Range("A2:D23")
   Set dict = CreateObject("scripting.dictionary")
  
      For j = 1 To jv.Rows.Count
         c00 = dict.Item(jv(j, 11))
      Next
  
      For Each it In dict.keys
         x = Application.Match(it, jv2.Columns(1), 0)
         y = Join(Application.Transpose(Application.Transpose(jv2.Cells(x, 3).Resize(, 2))), ":")
      
         For Each r In jv.Columns(11).Cells
            If r = it Then
              c00 = c00 & r.Offset(, -9) & "|"
              c01 = c01 & r.Offset(, 2) & "|"
            End If
         Next
       
         With Evaluate("'" & Sheets(1).Name & "'!" & y)
           .Value = Application.Transpose(Split(c00, "|"))
           .Offset(, 1) = Application.Transpose(Split(c01, "|"))
         End With
         c00 = "": c01 = ""
      Next
End Sub

 

[Vridos]

Super JVeer, deze doet inderdaad (nagenoeg) wat ik zoek.
Maar 1 dingetje doet hij niet en dat is de teamnaam in "A1" zetten.
Hij zet het eerste teamlid in "A1", waar deze in "A2" zou moeten.
Dan is duidelijk om welk team het gaat.

 

[snb]

Ik heb in ieder geval een nieuw, intrigerend woord geleerd: 'fluitlicentie'. Lijkt me in veel situaties toepasbaar

Voeg aan de ledenlijst kolomtitels toe.
Dan volstaat:

Sub M_snb()
  sn = Blad5.Cells(1).CurrentRegion
  
  For j = 2 To UBound(sn)
    With Blad4.Cells(1).CurrentRegion
      .AutoFilter 11, sn(j, 1)
      Blad3.Cells(1, 3 * j - 5) = sn(j, 1)
      .Offset(1).Columns(2).Copy Blad3.Cells(2, 3 * j - 5)
      .Offset(1).Columns(13).Copy Blad3.Cells(2, 3 * j - 4)
      .AutoFilter
    End With
  Next
End Sub

Waarom tussen 2 teams 3 kolommen zitten is onduidelijk, tenzij uit onbekendheid dat kolommen verbreed kunnen worden ?

 

[JEC.]

Ook de aanpassing gedaan in mijn code. Die vermoedelijk iets sneller zal zijn dan de (korte) autofilter methode.

 

[Vridos]

snb veel plezier met je nieuw ontdekte woord en wat betreft de tussen liggende kolommen.
Iedereen, met een fluitlicentie, moet bij ons wedstrijden fluiten en in die kolommen zet ik de data wanneer ze geweest zijn.
Zo is makkelijker te zien wie hoe vaak en wanneer geweest is.

Iedereen bedankt voor het meedenken en oplossen van mijn probleem.
Het werkt nu zoals ik graag wil.

 

[snb]

Die gegevens horen natuurlijk gewoon in de ledenlijst te staan.

@Jveer

Dat verschil ga jij niet waarnemen.

 

[HSV]

Ook een duit.

Lijkt me wel razendsnel.

Sub hsv()
sv = Sheets(2).Cells(1).CurrentRegion
sv2 = Sheets(3).Cells(1).CurrentRegion.Resize(, 4)
Set d = CreateObject("scripting.dictionary")
   For i = 2 To UBound(sv)
     d.Item(sv(i, 11)) = d.Item(sv(i, 11)) & "|" & sv(i, 2) & "|" & sv(i, 13)
   Next i
     For Each Key In d.keys
      ReDim a(1, 0) As String
        x = Application.Index(sv2, Application.Match(Key, Application.Index(sv2, 0, 1), 0), 3)
        sq = Split(Mid(d.Item(d.keys()(jj)), 2), "|")
        a(0, UBound(a, 2)) = Key
            For j = 0 To UBound(sq) Step 2
              ReDim Preserve a(1, UBound(a, 2) + 1)
              a(0, UBound(a, 2)) = sq(j)
              a(1, UBound(a, 2)) = sq(j + 1)
            Next j
      Sheets(1).Range(x).Resize(UBound(a, 2) + 1, 2) = Application.Transpose(a)
    jj = jj + 1
  Next Key
End Sub