VBA/Formule Vertidaal zoeken met gegevens die ALT+Enter bevaten

[Tweety1]

Ik heb een excel bestand waar ik onder een cel een lijst met namen heb staan door middel van Gegevensvalidatie. De namen kun je vervolgens meerdere keren selecteren en plaats het via een macro onder elkaar met een Alt+Enter ertussen. Nu wil ik een andere cel via verticaal zoeken de gegevens aanvullen. Alleen de gegevens die daar staan hebben staan op naam. Is dit mogelijk?

Nadat mensen het bestand hebben ingevuld wil ik de regels die een alt enter bevatten verplaatsen naar een nieuwe regel.
Ik heb wel al een macro die gegevens van kolom F verplaats naar nieuwe cellen alleen wil ik ook dat hij de gegevens van kolom I mee neemt.

mvg

Kasper


Voorbeeld:
Bekijk bijlage 201703

 

[namliam]

Deze code zou het moeten doen voor je..... Neemt I en J mee, neemt wel voor het gemak aan dat alle cellen evenveel "waarden" bevat

Sub Distribute()

Dim DataArray As Variant
Dim c As Range, CopyRng As Range
Dim StartLine As Long

For Each c In Columns("F").SpecialCells(xlCellTypeConstants)
    If InStr(1, c.Value, Chr(10)) <> 0 Then
        Set CopyRng = Range(Cells(c.Row, 1), Cells(c.Row, Columns.Count).End(xlToLeft))
        DataArray = Split(c.Value, Chr(10))
        StartLine = c.Row
        Cells(StartLine, 1).Resize(UBound(DataArray), 1).EntireRow.Insert xlShiftDow
        Cells(StartLine, 1).Resize(UBound(DataArray) + 1, CopyRng.Cells.Count) = CopyRng.Value
        Cells(StartLine, 6).Resize(UBound(DataArray) + 1, 1) = Application.Transpose(DataArray)
[COLOR="#FF0000"]        DataArray = Split(c.Offset(0, 3).Value, Chr(10))
        Cells(StartLine, 9).Resize(UBound(DataArray) + 1, 1) = Application.Transpose(DataArray)
        DataArray = Split(c.Offset(0, 4).Value, Chr(10))
        Cells(StartLine, 10).Resize(UBound(DataArray) + 1, 1) = Application.Transpose(DataArray)[/COLOR]        
    End If
Next c
Rows("1:" & Rows.Count).EntireRow.AutoFit

End Sub

Rode regels heb ik toegevoegd, wil je echt alleen kolom I, dan verwijder je de laatste 2 rode regels

 

[Tweety1]

Bedankt,

Nu nog het verticaal opzoeken hoe kan ik dat oplossen?

 

[namliam]

waar wil je verticaal zoeken dan?
Je wil de gegevens in het rood opzoeken in de tabel eronder? Of op het tabblad "Docent"?

Dat laatste lijkt haalbaar, maar alleen NADAT je met de oude sub de docenten gesplitst hebt in kolom F. Voor I3 zou dat dan zijn:
=VLOOKUP([@BM1A],Docent!$A:$D,2,FALSE)
Of in het nederlands:
=Vert.Zoeken([@BM1A],Docent!$A:$D,2,Onwaar)

Voor kolom J zou je dezelfde functie gebruiken, maar dan de 2 in 3 veranderen.

 

[Tweety1]

Het klopt dat de de gegevens van het tabblad Docent komen.

Maar is het ook mogelijk voordat de regels worden gesplitst verticaal te zoeken?

 

[namliam]

Je zou dan zoeken op het samengevoegde veld, is wel mogelijk maar dan krijg je het lastig....
Je kan ook de boel splitsen en vlookupen in een...

Met deze regel zet je in kolom I de Vlookup neer:

Cells(StartLine, 9).Formula = "=VLOOKUP([@BM1A],Docent!$A:$D,2,FALSE)"

om kolom J op te zoeken verander je dus de 9 in 10 en 2 in 3

 

[Tweety1]

Ok, de kolomen i en j had ik er bij gezet om te laten zien hoe ik het eruit wil laten zien. In kolom g staat een formule die alleen werkt als er 1 docent staat. Als er meerdere staan dan krijg je een foutmelding.
Ik zou graag eerst de gevens willen zien en daarna pas splitsen

 

[namliam]

Eerst de samengestelde informatie en dan pas splitsen wordt lastig, omgekeerd is 10 maal eenvoudiger.
Het werkt wel als je ook de samengestelde informatie als bron hebt in je lookup, maar dat lijkt me wat tricky?
Dan moet je alle mogelijke combinaties van docenten door elkaar heen gaan invoeren, wordt een flinke puzzel?

Eventueel kan je ook iets doen in de richting van

=VERT.ZOEKEN(LINKS([@BM1A],VIND.ALLES(TEKEN(10),[@BM1A],1)-1),Docent!A:D,2,ONWAAR) & TEKEN(10)  
&VERT.ZOEKEN(LINKS([@BM1A],VIND.ALLES(TEKEN(10),[@BM1A],VIND.ALLES(TEKEN(10),[@BM1A],1))-1),Docent!A:D,2,ONWAAR)

Dit "werkt" voor 2, maar weer niet voor 1, voor 3 kan ook maar dan wordt het nog complexer

 

[Tweety1]

OK, denk dat het dan beter is om eerste spitsen en dan pas verticaal zoeken.
Weet je toevallig ook hoe ik de macro kan aanpassen zodat ik op een ander tabblad de gegevens kan splitsen zonder eerst naar die pagina te gaan
Ik wil het namelijk op een verborgen tabblad uitvoeren zonder de pagina te laten zien (achter de schermen)

Sheets("voorbeeld").

En is het ook mogelijk om de regels die aangemaakt worden te nummeren in een aparte kolom?

Kolom Kolom Kolom
Vak 1 Docent 1
Vak 1 Docent 2 02
Vak 2 Docent 2
Vak 2 Docent 3 02
Vak 2 Docent 3 03
Vak 3 Docent 1
Vak 3 Docent 3 02
Vak 4 Docent 2

 

[namliam]

alles is mogelijk, een kwestie van coderen

Alles wat je op een andersheet wil doen, zet je in plaats van CELLS... Sheets("Sheetnaam").Cells

Het heeft wel enige tweaking nodig om e.a. werkend te maken omdat je nu natuurlijk op een sheet werkt.
Als het enige is dat je de bewerking "onzichtbaar" wil maken, kan je ook "simpel" het scherm uitzetten.
Application.Screenupdating = false
En weer aan
Applicaton.screenupdating = true
Of iets in die regione, al heb ik nu direct even niet de tijd om te zoeken voor je

 

[Tweety1]

Het uitvoeren op het verborgen tabblad gaat goed. Maar hoe kan de nummering erbij krijgen

 

[namliam]

de nummering, ongeveer zo:

Dim i As Integer
...
        Cells(StartLine, 6).Resize(UBound(DataArray) + 1, 1) = Application.Transpose(DataArray)
        For i = 0 To UBound(DataArray)
            Cells(StartLine + i, 11) = i + 1
        Next i

Hoop dat je hiermee uit de voeten komt?

 

[Tweety1]

Heel erg bedankt!!