namen zoeken

[R0bert]

Ik heb in blad 1 een lijst met voornamen (A), achternamen (B) Man/Vrouw-aanduiding (C) en een teamindeling (D)
Ik wil op een andere blad in kolom A de namen van de mannen uit team "A1" zetten en in kolom B de vrouwen uit dat team. Op een volgend blad de mannen en vrouwen uit team "A2" enz.
Hoe kan ik bereiken dat de juiste namen uit blad 1 in de betreffende teambladen komen te staan?
Ik hoop dat iemand me hierbij kan helpen!

 

[HSV]

Met een macrootje.

Sub hsv()
Dim sn, arr, cl, j As Long, x As Long
sn = Sheets("Blad1").Cells(1).CurrentRegion
For Each cl In Array("A1", "A2")
ReDim arr(1, 0)
 For j = 1 To UBound(sn)
      If sn(j, 4) = cl Then
          x = sn(j, 3) = "V"
          arr(Abs(x), UBound(arr, 2)) = sn(j, 1) & " " & sn(j, 2)
          ReDim Preserve arr(1, UBound(arr, 2) + 1)
       End If
     Next j
 With Sheets(cl)
   .Cells(1).CurrentRegion.Offset(1).ClearContents
   .Cells(2, 1).Resize(UBound(arr, 2), 2) = Application.Transpose(arr)
   .Columns(1).Resize(, 2).SpecialCells(4).Delete
 End With
  Erase arr
  Next cl
End Sub

 

[R0bert]

Beste Harry,
Jemig, dit gaat mijn Excel-kennis behoorlijk te buiten! Geen wonder dat ik er met o.a. verticaal zoeken niet uit kwam!
Ik ga het proberen, bedankt voor je hulp.
mvg,
Rob

 

[joost1]

Met een paar handelingen kun je het ook zonder een macrootje oplossen.
Maak gebruik van de functie filter , kopiëren en plakken speciaal > koppeling plakken.

Groet

 

[R0bert]

Ja, dat is ook een goeie! Iets meer werk maar ik snap hoe het werkt.
Bedankt, Joost.
Groeten,
Rob

 

[HSV]

Ik heb de code aan een knop gehangen voor als je van minder werk houdt.
Maar het hoeft natuurlijk niet als je zoal tevreden bent.

 

[R0bert]

Top Harry!
In werkelijkheid gaat het om een bestand met 150 namen en 14 teams. Nadat ik voor alle teams een werkblad had gemaakt en de macro bij de "For Each cl In Array" op goed geluk had uitgebreid (ik snap de programmeertaal namelijk voor geen meter ), liep de indeling als een speer!
Ik ben er heel blij mee!!
Groeten,
Rob

 

[R0bert]

Macro aanpassen

Beste Harry,
Ik permitteer me toch nog een aanvullende vraag.
Het toegestuurde bestand "Teamindeling" is een afgeleide van een groter (en iets anders ingedeelde) basisbestand.
De macro die je hebt gemaakt kijkt naar het tabblad "Namen" en zet dan de spelers uit kolom A & B op basis van "Man / Vrouw (kolom C) in het juiste team als opgenomen in kolom D. Nogmaals: top!

Ik zou graag de macro willen toepassen op het basisbestand. Daarin staan de namen in het tabblad "Teamindeling", in kolom B & C. De M/V aanduiding staat in kolom D en de teams staan in kolom P.
Omdat ik de programmeertaal niet begrijp weet ik niet hoe ik de macro moet aanpassen. In ieder geval zal: sn = Sheets("Namen") moeten worden veranderd in sn = Sheets("Teamindeling"), lijkt me. Maar wat er verder moet worden aangepast weet ik echt niet.
Zou je me dat willen vertellen?
En maakt het voor de werking van de macro uit of ik de kolommen A en E t/m J verberg?

Als de macro daarop werkt kan ik het (overbodige) tabblad Namen weggooien. Een gedeelte van het basisbestand voeg ik als bijlage bij.
Ik hoop dat je me hiermee kan helpen!
Groeten, Rob

Bekijk bijlage indeling spelers testbestand.xlsm

 

[ExcelAmateur]

Het toegestuurde bestand "Teamindeling" is een afgeleide van een groter (en iets anders ingedeelde) basisbestand.

Je moet altijd als voorbeeld de zelfde indeling maken, dan is de code waarschijnlijk ineens goed.

 

[HSV]

Hallo Robert,

Het maakt niet uit of je de kolommen A t/m E verbergt.

Private Sub CommandButton1_Click()
Dim sn, arr, cl, j As Long, x As Long
Application.ScreenUpdating = False
sn = Sheets("Teamindeling").Cells(1).CurrentRegion
For Each cl In Array("A1", "A2", "B1")
ReDim arr(1, 0)
 For j = 1 To UBound(sn)
      If sn(j, 16) = cl Then
          x = sn(j, 4) = "V"
          arr(Abs(x), UBound(arr, 2)) = sn(j, 2) & " " & sn(j, 3)
          ReDim Preserve arr(1, UBound(arr, 2) + 1)
       End If
     Next j
 With Sheets(cl)
   .Cells(1).CurrentRegion.ClearContents
   .Cells(1).Resize(UBound(arr, 2), 2) = Application.Transpose(arr)
   .Columns(1).Resize(, 2).SpecialCells(4).Delete
 End With
  Erase arr
  Next cl
End Sub

 

[R0bert]

macro invoeren

Het is een beetje in de soep gelopen.

Mogelijk komt het omdat ik de macro niet op de goede manier heb ingevoerd. Om de macro in te voeren open ik het bestand en kies dan Macro's -> Macro opnemen.
Ik moet dan de macro eerst een naam geven en kies daarbij voor "Indelen". en klik op OK. direct daarna kies ik voor "opname stoppen".
Dan kies ik "Bewerken" en kopieer ik de tekst van de toegestuurde macro in de opgenomen loze macro.
Dat blijkt niet goed te werken; de macro wordt niet gezien.

Ik realiseer me dat het nogal dommig zal overkomen, maar hoe kan ik op een correcte manier de toegestuurde macro aan het bestand koppelen?

In de hoop dat je nog een keer wilt helpen stuur ik het integrale bestand mee.

Met verontschuldiging voor het gestuntel, maar de macro is gewoon te mooi om het erbij te laten zitten....

mvg,
Robert

 

[R0bert]

Oeps, bestand vergeten, bijgaand alsnog....Bekijk bijlage Meerjarige teamindeling nieuw.xlsx

 

[HSV]

Ik heb de code aan de commandbutton1 gehangen.
Die zie met Alt+F8 niet.
Dubbelklik daarvoor in Vb-editor op "Blad1 (teamindeling)".

 

[R0bert]

Ik heb het testbestand met kopiëren en plakken aangevuld met de gegevens uit het basisbestand. Uitgeprobeerd en.... hoppa!! als een tierelier!
Dank Harry en andere meedenkers!

 

[R0bert]

Aan de knop met CommandButton1 hangt de code voor de teamindeling en die werkt perfect.
Macro's die ik opneem kan ik aan een besturingselement hangen. De naam van zo'n element kan ik aanpassen, maar die van de CommondButton1 niet. Hoe kan die naam aangepast worden?

 

[HSV]

Zoek naar potlood\driehoek\liniaal.
Druk daar op; nu kan je de commandbutton selecteren.
Rechtermuisklik-eigenschappen-caption.

 

[Timshel]

Op de valreep nog een alternatief:

Private Sub CommandButton1_Click()
    Dim Br, i As Long
    
    Application.ScreenUpdating = False
    Br = Sheets("Teamindeling").Cells(1).CurrentRegion
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(Br)
            .Item(Br(i, 16)) = .Item(Br(i, 16)) & "|" & IIf(Br(i, 4) = "V", "_", "") & Br(i, 2) & " " & Br(i, 3)
        Next
        For Each Br In .Keys
            Sheets(Br).Cells(1, 1).Resize(UBound(Split(.Item(Br), "|")) + 1) = Application.Transpose(Split(.Item(Br), "|"))
            Sheets(Br).Range("A2:A" & Sheets(Br).Cells(Rows.Count, 1).End(xlUp).Row).TextToColumns , , , , , , , , 1, "_"
            Sheets(Br).Columns(1).Resize(, 2).SpecialCells(4).Delete
        Next
    End With
End Sub

 

[R0bert]

Geweldig, de hulp die ik op dit form krijg! Oprechte dank allemaal!!! :thumb:

 

[R0bert]

Er treedt een foutmelding op bij het indeling van de spelers bij de diverse teams (zie bijlagen).
Omdat ik de werking van de VB macro niet kan doorgronden, weet ik ook niet hoe / waar ik de fout kan oplossen.
Heeft iemand een suggestie??

 

[Timshel]

Is de kolommenindeling van het werkblad Teamindeling veranderd?