Van Tabel naar lijst

[timmetj87]

Beste Allemaal,

Ik heb een matrix van iemand gekregen om verder te verwerken in ons ledenbestand.
Deze matrix moet een lijst worden.
Deze persoon heeft allemaal X gezet maar dit moet eigenlijk het getal zijn dat op Rij 1 staat boven het Xtje.

Hoe de uitkomst zou moeten zijn zie je in tabblad 2.

Hoe kan ik dit in Excel automatiseren?

 

[Cobbe]

Kijk eens of dit in de buurt komt.
Heb 2 macrobuttons links in cel A1 gezet.

 

[timmetj87]

Goedenavond Cobbe,

Dit ziet er al heel goed uit maar is het nog niet helemaal.
Nu komt bij Medewerker nummer 9 het in Kolommen naast elkaar en het moet onder elkaar komen.
Dus
9 501
9 502
9 503
9 504
9 505
9 506

 

[MarcelBeug]

Op Blad3 heb ik een oplossing met een hulpkolom en formules. In de hulpkolom komen rij-/kolomnummercombinaties van de cellen met een "x" op blad1.
In kolom B komt het medewerkernummer van het betreffende rijnummer en in kolom C het nummer op regel 1 van Blad1 in de betreffende kolom.
Formules op regel 2 en gekopieerd naar beneden (A2 is dus een matrixformule, bevestigd met Ctrl+Shift+Enter):

A2 =KLEINSTE(ALS(Blad1!$B$3:$V$27="x";100*RIJ(Blad1!$B$3:$V$27)+KOLOM(Blad1!$B$3:$V$27));RIJEN(A$2:A2))
B2 =INDEX(Blad1!A:A;INTEGER(A2/100))
C2 =INDEX(Blad1!$1:$1;REST(A2;100))

In het algemeen is dit wel een aardige methode om gegevens uit een matrix te selecteren (te "unpivotten").
Als meer universele oplossing moet je de 100 telkens wijzigen in 100000 omdat het maximale kolomnummer 5 cijfers heeft (16384).

 

[gast0660]

Hoi,
ander ideetje

 

[snb]

Met VBA:

Sub M_snb()
   sn = [if(A3:V27="X",A3:A27&"_"&A1:V1,"")]
   ReDim sp(Application.CountIf(Sheet1.Range("A3:V27"), "X"), 1)
   
   n = 0
   For j = 1 To UBound(sn)
      For Each it In Filter(Application.Index(sn, j), "_")
        sp(n, 0) = Split(it, "_")(0)
        sp(n, 1) = Split(it, "_")(1)
        n = n + 1
      Next
   Next
   
   Sheet2.Cells(1, 6).Resize(UBound(sp), 2) = sp
End Sub

 

[WHER]

Nog eentje op basis van een Dictionary die
a: lijkt te werken
b: dezelfde Key lijkt te associëren met verschillende Items? Of zie ik dat verkeerd?

 

[rebmog]

Nog in formule-variant zonder hulpkolom:
In A2:

=KLEINSTE(ALS(Blad1!B$3:V$28="X";Blad1!A$3:A$28);RIJ(A1))

en in B2:

=KLEINSTE(ALS(VERSCHUIVING(Blad1!B$2:V$2;VERGELIJKEN(A2;Blad1!A$3:A$27;0);)="X";Blad1!B$1:V$1);AANTAL.ALS(A$2:A2;A2))

Beide formules zijn matrixformules.

 

[snb]

@Wher

Ik zou hem iets robuuster maken door te verwijzen naar de werkbladen.

Sub M_wher()
    With CreateObject("Scripting.Dictionary")
        For Each cl In Sheet1.Range("B3:V27").SpecialCells(2)
            .Item(Sheet1.Cells(cl.Row, 1)) = Sheet1.Cells(1, cl.Column)
        Next
        
        Sheet2.Range("A2").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .Items))
    End With
End Sub

Mij verbazen die identieke sleutels (keys) ook.
De eigenschappen van de key worden blijkbaar alleen geëvalueeerd als tekstreeks (string) of als getal (number).
Omdat je hier de cel (=range) gebruikt worden ze niet als identiek beschouwd.

Als je in plaats van

.Item(Sheet1.Cells(cl.Row, 1))

.Item(Sheet1.Cells(cl.Row, 1).Value)

of

.Item(Sheet1.Cells(cl.Row, 1).Text)

gebruikt wordt het aantal sleutels gereduceerd tot 25.

Via de eigenschappen van de keys (bijv. met vartype of typename) is geen verschil te ontdekken.
Curieus. Weer wat geleerd dankzij jou WHER. :thumb:

 

[WHER]

Ik had die aanpak "stommelings" opgezet en pas achteraf beseft: hé hoe kan dat nu?
Het vermoeden dat het met de Range i.p.v. Value of Text te maken heeft, had ik ook.

 

[rebmog]

@snb, @WHER
Als je in de key van de dictionary geen property aangeeft wordt by design volgens mij altijd het object opslagen (in dit geval dus een range-object), zoals je in onderstaande code kunt zien:

Sub Rebmog()
    Set oDic = CreateObject("Scripting.Dictionary")
    With Sheet1
        For Each cl In .Range("B3:V27").SpecialCells(2)
            oDic.Item(.Cells(cl.Row, 1)) = .Cells(1, cl.Column)
        Next
    End With
    For Each var In oDic.keys
        Debug.Print var.Address
    Next
End Sub

 

[snb]

@rebmog

Klopt. Bijft curieus dat twee dezelfde ranges niet als identiek worden gezien.

 

[rebmog]

Dat is toch minder curieus dan je zou denken, want het gaat om unieke range-objecten en niet om unieke ranges. In de loop wordt telkens als het ware automatisch een nieuwe instantie van het range-object aangemaakt en dat object wordt dan gekoppeld aan een bepaalde range. Zie voor het verschil bijgaande 2 code-voorbeelden:

Sub Rebmog_5_Objecten()
    With CreateObject("Scripting.Dictionary")
        For i = 1 To 5
            Set rng = Range("A1")
            .Item(rng) = ""
        Next
        For Each var In .keys
            Debug.Print var.Address
        Next
    End With
End Sub

Sub Rebmog_1_Object()
    With CreateObject("Scripting.Dictionary")
        Set rng = Range("A1")
        For i = 1 To 5
            .Item(rng) = ""
        Next
        For Each var In .keys
            Debug.Print var.Address
        Next
    End With
End Sub

 

[alphamax]

Misschien een extra controle met .exists!?

 

[MarcelBeug]

Zou Timmetje intussen lekker aan het strand liggen of anderszins van het mooie weer genieten? :d