• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Aantal unieke combinatie met som van aantallen

Status
Niet open voor verdere reacties.
P

pesall

Gebruiker
Lid geworden
1 nov 2016
Berichten
30
Beste gurus,

Ik wil in excel met behulp van een macro, vba of iets dergelijks van een dimensie met waarden (A t/m j) de unieke combinaties weergeven met de aantallen.
zie bijlage. HBekijk bijlage vbdim.xlsxoop dat iemand kan meedenken, bedankt alvast.
 
Zoiets?

Code: 
Function VenA(r As Range, s As String)
ar = r
For j = 1 To UBound(ar)
  If InStr(1, s, ar(j, 1)) <> 0 Then VenA = VenA + ar(j, 2)
Next j
End Function
 

Bijlagen

Hi Giga,

Bedankt voor je feedback. De in kolom A weergegeven combinaties dient hij ook te bepalen als voorbeeld heb ik een paar combinaties handmatig erin gezet ter illustratie.
 
De letters A t/m J vertegenwoordigen de hoeveelheid stof in een type product. Product bestaat uit verschillende types (A t/m J). Hiermee kan ik een overzicht creeren hiervoor.
 
Een kleine UDF kan je helpen om simpelweg een opgegeven code om te zetten naar de hoeveelheid stoffen...
Code: 
Function StofTotaal(sCode As String, rBereik As Range) As Integer

    For i = 1 To Len(sCode)
        StofTotaal = StofTotaal + Application.Index(rBereik, Application.Match(Mid(sCode, i, 1), Application.Index(rBereik, 0, 1), 0), 2)
    Next i

End Function
Het lijkt mij erg onzinnig om een hele tabel aan te leggen met alle mogelijke combinaties terwijl je van slechts 1 opgegeven combinatie de waarde wilt weten. ;)

Plaats de UDF in een standaard module van je workbook. De functie roep je in de worksheet aan met: =StofTotaal(A16;$A$2:$B$11) (voor bijvoorbeeld het bepalen van de hoeveelheid stoffen voor de code in cel A16)
 
Laatst bewerkt:
Dag Ginger,

Het lijkt onzinnig tot dat een van deze combinaties de juiste combinatie en hoeveelheid is voor het maken van nieuwe medicijnen :d.
Maar ik snap je punt. Voor bovenstaande voorbeeld zou ik 2 tot de macht 10 (-1) mogelijkheden moeten hebben denk ik. dus 1023.
Ik heb je voorbeeld bekeken maar het is niet wat ik zoek. En bedankt voor het meedenken.
 
Laat dan even deze Sub lopen...
Code: 
Sub AanmakenCombinaties()

    For i = 65 To 74
        For ii = i To 74
            x = x + 1
            tmp = tmp & Chr(ii)
            Cells(x, 7).Value = tmp
       Next ii
        tmp = ""
    Next i

End Sub
Aantal unieke permutaties is volgens mij slechts 55 stuks. Met combinaties wordt het een ander verhaal, maar dat haal ik niet uit je voorbeeldje...

..en zet daarna mijn UDF in om de waardes van zo'n code te berekenen.
 
Mocht je beschikken over Excel 2016, dan kan dit "eenvoudig" ;) met de functies TEKST.COMBINEREN en BIT.EN.

Code: 
Combinaties, in F2: =TEKST.COMBINEREN("";1;ALS(0<BIT.EN(RIJEN(F$2:F2);2^{0;1;2;3;4;5;6;7;8;9});$A$2:$A$11;""))
    Waarden, in G2: =SOMPRODUCT((0<BIT.EN(RIJEN(G$2:G2);2^{0;1;2;3;4;5;6;7;8;9}))*$B$2:$B$11)

Formules kopiëren naar beneden t/m regel 1024.
 

Bijlagen

Jeetje, respect voor jullie!!

@MarcelBeug, ziet er perfect uit. Thuis heb ik wel office 365 dus werkt prima. Alleen weet ik niet als het op werk ook gaat werken op 2010.
@Ginger, deze ziet er ook goed uit, alleen mis ik wel combinaties zoals ABDE.

Is het ook mogelijk om de formules in een macro of zo op te nemenMarcelBeug, met een formule op de afzonderlijke cellen is een foutkans in de berekening toch iets groter.
 
pesall zei:
@Ginger, deze ziet er ook goed uit, alleen mis ik wel combinaties zoals ABDE.
Klik om te vergroten...

Ah, ik meende uit je voorbeeldje op te maken dat de letters in volgorde moesten blijven. Als je vanavond nog geen sluitende oplossing hebt ontvangen, zal ik nog ff voor je kijken.
 
Ok, bedankt.
En nee, hoeft niet op een bepaalde volgorde als alle mogelijke combinaties maar terugkomen (1024). En betekend het dat ik 2 modules moet maken voor beide scripts, voor combinatie en aantallen?
 
Hierbij nog een formulevariant die ook in Excel 2007 werkt. Een macro oplossing laat ik graag aan de VBA-ers over.
 

Bijlagen

Hi MarcelBeug,

Top, bedankt hiervoor. Hier ben ik al super blij mee. Indien iemand een script heeft is het zeker meegenomen.
Nogmaals bedankt voor het meedenken.:thumb:
 
Ik zit maar te wachten op Ginger..... ;)

Ik dacht aan:

Code: 
Dim sp, sq, sn, y, c00

Sub M_snb()
   c00 = "ABCDEFGHIJ"
   sn = Array(0, 20, 12, 9, 15, 6, 20, 14, 7, 6, 2)
   y = -1
   ReDim sp(9, 1)
   ReDim sq(2000, 1)
   
   For j = 1 To Len(c00)
     y = y + 1
     sp(0, 0) = Mid(c00, j, 1)
     sp(0, 1) = sn(InStr(c00, Mid(c00, j, 1)))
     sq(y, 0) = sp(0, 0)
     sq(y, 1) = sp(0, 1)
     For jj = j + 1 To Len(c00)
        M_snb_000 1, jj
     For jjj = jj + 1 To Len(c00)
        M_snb_000 2, jjj
     For jjjj = jjj + 1 To Len(c00)
        M_snb_000 3, jjjj
     For jjjjj = jjjj + 1 To Len(c00)
        M_snb_000 4, jjjjj
     For jjjjjj = jjjjj + 1 To Len(c00)
             M_snb_000 5, jjjjjj
     For jjjjjjj = jjjjjj + 1 To Len(c00)
        M_snb_000 6, jjjjjjj
     For jjjjjjjj = jjjjjjj + 1 To Len(c00)
        M_snb_000 7, jjjjjjjj
     For jjjjjjjjj = jjjjjjjj + 1 To Len(c00)
        M_snb_000 8, jjjjjjjj
     For jjjjjjjjjj = jjjjjjjjj + 1 To Len(c00)
        M_snb_000 9, jjjjjjjjjj
     Next
     Next
     Next
     Next
     Next
     Next
     Next
     Next
     Next
     Next

    Cells(2, 11).Resize(UBound(sq), 2) = sq
End Sub

Sub M_snb_000(x, z)
    y = y + 1
    sp(x, 0) = sp(x - 1, 0) & Mid(c00, z, 1)
    sp(x, 1) = sp(x - 1, 1) + sn(InStr(c00, Mid(c00, z, 1)))
    sq(y, 0) = sp(x, 0)
    sq(y, 1) = sp(x, 1)
End Sub
 

Bijlagen

Dag SNB,

Het werkt perfect!
Indien ik A t/m J wil vervangen met de naam van de componenten betekent het dat ik "ABCDEFGHIJ" in de script kan vervangen met deze namen?
 
Dag SNB,

Ik zie toch een paar foutjes. Zo zie ik bijvoorbeeld dat de code ABCDEFGHH en ABCDEFGII voorkomen. dat betekend dat hij de H en de I twee keer telt en dit is dus niet helemaal goed.
 
snb zei:
Ik zit maar te wachten op Ginger..... ;)
Klik om te vergroten...

snb, grappig... Ik ben grmbl de grmbl de héle fokking avond bezig geweest om het voor elkaar te krijgen met letters. Te zot voor woorden! Combinaties voor bijvoorbeeld de Lotto is geen probleem omdat je dan vasthoudt aan je 6 tekens. Maar nu.... je string moet steeds worden opgebouwd van 1 t/m 11 characters. Ik kwam niet meer uit m'n lus...

Dit was het laatste wat ik me kon bedenken....
Code: 
Sub AanmakenCombinaties3()

    For i = 65 To 74
        Letter1 = Chr(i)
        x = x + 1
        Cells(x, 7).Value = Letter1
            For ii = 1 To (74 - i)
                For iii = i + ii To 74
                    x = x + 1
                    tmp = tmp & Chr(iii)
                    Cells(x, 7).Value = Letter1 & tmp
                Next iii
            tmp = ""
            Next ii
        Letter1 = ""
    Next i

End Sub
En is voor een deel goed. Maar helaas zou de stap na de string AJ verder gegaan moeten worden met AC, ACD, ACDE enz... Ik ga die van jou morgen bestuderen. Blij dat jij al gereageerd had, want ik wilde via dit draadje anders al een oproep naar je doen. :D
 
@Ginger,

Vergeet die vorige versie.
De hulpkolom van MB zette me aan het denken (moet je overigens wel mee oppassen...)
Dan ontstaat er een aardige illustratie van het voordeel van wiskunde: als ergens een patroon in zit heb je weinig regels nodig.
Het bevestigt de stelling: 'structuring precedes coding'.

Code: 
Sub M_snb()
   ReDim sq(2 ^ 10, 1)
   
   For j = 1 To UBound(sq)
     For jj = 0 To 9
      If ((j Mod 2 ^ (jj + 1)) \ (2 ^ jj)) Then
        sq(j, 0) = sq(j, 0) & Chr(65 + jj)
        sq(j, 1) = sq(j, 1) + Array(20, 12, 9, 15, 6, 20, 14, 7, 6, 2)(jj)
       End If
    Next
   Next
   
   Cells(1, 14).Resize(UBound(sq), 2) = sq
End Sub

Er is in ieder geval nog minstens 1 verbetering mogelijk: de tweede lus (met teller jj) loopt nu tot 9; dat moet beperkt kunnen worden door de hoogte van j; ik weet alleen nog niet hoe. Ik dacht eerst aan de wortel van j. Nog geen bevredigende oplossing.

PS. Dat 'goede' doel zouden net zo goed designer drugs kunnen zijn.....
 
Laatst bewerkt:
hier nog een mogelijkheid:
een function die bij ieder natuurlijk getal een unieke oplossing geeft.
als je het getal 0 invoert geeft de function het aantal mogelijkheden.
het draait nu om kleurtjes, maar dat wat je invult maakt niet uit.
je hebt met 13 kleurtjes meer dan 8000 mogelijkheden.
als je een te grote waarde invult geeft de function een waarschuwing.
 

Bijlagen

Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan