Formule gebruiken voor variabele data range

Status
Niet open voor verdere reacties.
T

TunesForToons

Nieuwe gebruiker
Lid geworden
7 mei 2019
Berichten
3
Hi all,

Misschien dat iemand mij kan helpen. Twee weken geleden ben ik voor het eerst begonnen met VBA basic en alhoewel ik al best ver ben gekomen loop ik nu toch echt vast na een weekend lang met het handen in het haar zoeken en speuren online.

Ik gebruik een formule om data te normaliseren maar het werkt niet helemaal. Wat ik graag zou willen is dat wanneer ik een bepaalde data range selecteer, dat naast deze range de genormaliseerde data wordt geplakt.

Ik heb dit al bijna aan de praat gekregen (zie excel sheet.png). Voorbeeld 1 Table.09: Hier zijn C6 tot en met H12 geselecteerd. Wanneer ik mijn macro run worden er mean en std dev gecalculeert en worden deze vervolgens gebruikt voor de genormaliseerde data in J6 tot en met O12. Dit werkt prima, de macro plakt dezelfde dimensies als de initiële data - zelfde aantal kolommen + rijen - telkens 1 lege kolom opgeschoven.

Wanneer ik hetzelfde probeer door B19 tot en met D23 te selecteren en dan de macro te runnen loopt het fout. De macro plakt weer hetzelfde aantal kolommen+rijen als initiële selectie, en ook mean+std dev en doet dit zelfs goed door steeds 1 lege kolom tussen te laten. Wat echter niet goed loopt is dat de formule die ik op dit moment gebruik gebaseerd is op kolomoffset die lastcolumn gebruikt. Hierdoor werkt het niet meer als er geen Total kolom (kolom B) staat omdat dit het begin punt veranderd. Hierdoor probeert de formule K19 en L19 te gebruiken, terwijl dit J19 en K19 moet zijn.

Het idee is dat de macro werkt voor Table 9 wanneer ik C6 t/m H12 selecteer, maar ook in het geval van Table 10 wanneer ik B19 t/m D23 selecteer.

Is er iemand die mij kan helpen?

Bijgevoegd staat het excel bestand waar de macro in staat.

Heel erg bedankt!
 

Bijlagen

  • Excel sheet.PNG
    Excel sheet.PNG
    87,3 KB · Weergaven: 50
  • Test3.0.xlsm
    19,9 KB · Weergaven: 21
  • excel macro.PNG
    excel macro.PNG
    93 KB · Weergaven: 48
Laatst bewerkt:
Volgens mij heb ik 'm wel.
 

Bijlagen

  • Test3.0.xlsm
    23,8 KB · Weergaven: 27
OctaFish zei:
Volgens mij heb ik 'm wel.
Klik om te vergroten...

Wow super bedankt! Het werkt perfect :eek: Dit had ik nooit zelf kunnen uitvogelen. Many many thanks

Zou ik nog 1 ding mogen vragen? Het is iets kleins :)

Ik ben een beetje gaan puzzelen met conditional formatting (leuk om dat allemaal uit te zoeken ^^) en heb ondertussen wat kunnen toegevoegen. Het werkt voor de genormaliseerde data maar ik zou graag ook de initieel geselecteerde data conditioneel formatten gebaseerd op de genormaliseerde data. Wat ik bedoel is dat wanneer ik C6 t/m H12 selecteer dat voor iedere cell als de waarde van J6 t/m O12 boven de 120 komt de cel een groene kleur krijgt en onder de 80 een rode kleur.

Handmatig kan ik dit doen door cond form -> new rule -> use a formule to determine which cells to format -> =J6>120 -> format instellingen.
En dit dan nog eens herhalen voor =J6<80.

Dat werkt, behalve dat dit niet dynamisch is. Ik heb zelf al wat geprobeerd in Module 2 om J6 te veranderen in Selection.Columns.Count+1 maar dit lukte niet.

In het voorbeeld zou in dit geval bij
Table 9. C6,D8, etc groen moeten worden, D9,D10 etc roze.
En dan voor Table 11. B18 roze, C19 groen, etc.

Als dit zou kunnen in de werkende macro zou helemaal perfect zijn..
 

Bijlagen

  • WERKENDE MACRO - Copy.xlsm
    27,4 KB · Weergaven: 22
Waarom handel je niet alles binnen de macro af?

Code: 
Sub VenA()
Dim j As Long, jj As Long, r As Range, r1 As Range, ar
  If Selection.Cells.Count > 1 Then
    Set r = Selection.Cells(1)
    ar = Selection
    ReDim ar1(1 To UBound(ar), 1 To UBound(ar, 2) + 3)
    For j = 1 To UBound(ar)
      ar1(j, UBound(ar1, 2) - 1) = Application.Average(Application.Index(ar, j, 0))
      ar1(j, UBound(ar1, 2)) = Application.StDev(Application.Index(ar, j, 0))
      For jj = 1 To UBound(ar, 2)
        ar1(j, jj) = 100 + ((ar(j, jj) - ar1(j, UBound(ar1, 2) - 1)) * 20 / ar1(j, UBound(ar1, 2)))
      Next jj
    Next j
    Set r1 = r.Offset(, UBound(ar, 2) + 1).Resize(UBound(ar1), UBound(ar1, 2))
    With r1
      .Value = ar1
      With .Resize(, UBound(ar, 2)).FormatConditions
        .Delete
        .Add 1, 6, 80
        .Item(1).Interior.Color = vbMagenta
        .Add 1, 5, 120
        .Item(2).Interior.Color = vbGreen
      End With
    End With
  End If
End Sub
 
Laatst bewerkt:
VenA zei:
Waarom handel je niet alles binnen de macro af?

Code: 
Sub VenA()
Dim j As Long, jj As Long, r As Range, r1 As Range, ar
  If Selection.Cells.Count > 1 Then
    Set r = Selection.Cells(1)
    ar = Selection
    ReDim ar1(1 To UBound(ar), 1 To UBound(ar, 2) + 3)
    For j = 1 To UBound(ar)
      ar1(j, UBound(ar1, 2) - 1) = Application.Average(Application.Index(ar, j, 0))
      ar1(j, UBound(ar1, 2)) = Application.StDev(Application.Index(ar, j, 0))
      For jj = 1 To UBound(ar, 2)
        ar1(j, jj) = 100 + ((ar(j, jj) - ar1(j, UBound(ar1, 2) - 1)) * 20 / ar1(j, UBound(ar1, 2)))
      Next jj
    Next j
    Set r1 = r.Offset(, UBound(ar, 2) + 1).Resize(UBound(ar1), UBound(ar1, 2))
    With r1
      .Value = ar1
      With .Resize(, UBound(ar, 2)).FormatConditions
        .Delete
        .Add 1, 6, 80
        .Item(1).Interior.Color = vbMagenta
        .Add 1, 5, 120
        .Item(2).Interior.Color = vbGreen
      End With
    End With
  End If
End Sub
Klik om te vergroten...

Deze werkt ook perfect en ziet er veel eleganter uit :eek::thumb:
Ik zal ze alle twee bewaren. Die eerste van OctaFish begrijp ik gelukkig zelf.

cow18 zei:
alle voorwaardelijke opmaken die gelden in J6 kan je zo "dynamisch" aanpassen naar andere bereiken.
Code: 
Sub Aanpassen()
    For Each cf In Range("J6").FormatConditions                      'alle voorwaardelijke opmaken van J6 aflopen
        cf.ModifyAppliesToRange Range("J6:O13,S6:W13")                      'aanpassen van de range
    Next
End Sub
Klik om te vergroten...

Hoe zou ik dat vervolgens verwerken in de macro die ik heb? Wanneer ik daar mee knutsel kom ik niet ver..

Thanks to everyone for helping a noob like me :)
 
Het quoten is niet nodig.

In mijn code maak ik gebruik van array's. Het voordeel hiervan is dat alles in het geheugen wordt afgehandeld en dat je een minimale interactie hebt met het werkblad. (is een stuk sneller) Het stukje van de voorwaardelijk opmaak is een versimpelde versie van jouw macro-opname. (wel een beetje onleesbaar):d

Ik heb wat commentaarregels aan de code toegevoegd. Hopelijk wordt het dan iets duidelijker.

Code: 
Sub VenA()
Dim j As Long, jj As Long, r As Range, r1 As Range, ar
  If Selection.Cells.Count > 1 Then 'minimaal 2 cellen selecteren anders werkt het niet
    Set r = Selection.Cells(1) 'de eerste cel van de selectie wordt straks gebruikt om te bepalen waar het resultaat komt.
    ar = Selection 'zet de selectie in een array
    ReDim ar1(1 To UBound(ar), 1 To UBound(ar, 2) + 3) 'maak een nieuwe array met evenveel rijen en 3 extra kolommen
    For j = 1 To UBound(ar) 'doorloop alle rijen in de array waarin de selectie staat
      ar1(j, UBound(ar1, 2) - 1) = Application.Average(Application.Index(ar, j, 0)) 'bepaal het gemiddelde van de rij en zet deze in dezelfde rij en de 1 na laatse kolom van de nieuwe array
      ar1(j, UBound(ar1, 2)) = Application.StDev(Application.Index(ar, j, 0)) 'bepaal de standaard deviatie van de rij en zet deze in dezelfde rij en de laatse kolom van de nieuwe array
      For jj = 1 To UBound(ar, 2) 'voor elke cel in de rij
        ar1(j, jj) = 100 + ((ar(j, jj) - ar1(j, UBound(ar1, 2) - 1)) * 20 / ar1(j, UBound(ar1, 2))) 'bereken het reultaat en zet dit op dezelfde plek in de nieuwe array
      Next jj 'volgende cel in de rij
    Next j 'volgende rij
    Set r1 = r.Offset(, UBound(ar, 2) + 1).Resize(UBound(ar1), UBound(ar1, 2)) 'bepaal het bereik waar de nieuwe gegevens moeten komen
    With r1 'met het bereik
      .Value = ar1 'plaats de waarden van de berekingen (ar1)
      With .Resize(, UBound(ar, 2)).FormatConditions 'bepaal het gebied waar de voorwaardelijk opmaak moet komen
        .Delete ' Als  er al een voorwaardelijk opmaak staat haal deze weg
        .Add 1, 6, 80 'nieuw opmaakregel toevoegen 1 = cell value, 6 is less, 80 is de waarde
        .Item(1).Interior.Color = vbMagenta 'geef de 1e opmaaregel zijn opmaak
        .Add 1, 5, 120 'nieuw opmaakregel toevoegen 1 = cell value, 5 is greater, 12 is de waarde
        .Item(2).Interior.Color = vbGreen 'geef de 2e opmaaregel zijn opmaak
      End With 'klaar met de voorwaadelijk opmaak
    End With 'klaar met het nieuwe bereik
  End If
End Sub

Wat leesvoer over array's: http://www.snb-vba.eu/VBA_Arrays_en.html
 
Het voordeel van de eerste methode is natuurlijk dat je je formules houdt als je waarden verandert. Nu moet je steeds de macro opnieuw uitvoeren, anders kloppen je getallen niet meer. Het is maar waar je je voorkeur legt :).
 
En zo heb elk voordeel z'n nadeel:d Al stelt het niet zoveel voor om de formules ook eerst in de array te zetten.;)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan