Resultaten automatisch in matrix

[Klijhoofd]

Hallo,

Ik kom maar niet uit het volgende:



- Links een werkblad met 2 kolommen naast elkaar.
- Rechts matrix
- Nu wil ik een formule in de matrix die ervoor zorgt dat de resultaten van kolom 2 (in linker plaatje) worden geplaatst op de juiste plek in de matrix. In dit geval maakt hij het vakje groen.

Het mooiste zou zijn als de voorwaardelijke opmaak functie vermeden wordt. Er staan nu namelijk x (kruisjes) in sommige vakjes die ik het liefste wil behouden. Volgens mij vervallen die kruisjes bij gebruik van voorwaardelijke opmaak. Met de kruisjes kan ik namelijk in 1 overzicht de huidige situatie (kruisjes) vergelijken met de nieuwe situatie (gekleurde vakjes).

Ik hoop dat er een oplossing is. In de bijlage het voorbeeld.

Gr

Tom

 

[thise]

hi

ik vind geen codes terug op je excel dus ik weet niet goed wat je bedoeld.
wil je een soort van zeeslag met getallen ofz

iets meer info aub

 

[HSV]

Tom,

Zoek even het kleurnummer van de groene kleur die je hebt (de 6 staat voor geel).

Sub hsv()
Dim cl As Range
With Sheets("blad1")
   .UsedRange.Interior.ColorIndex = xlNone
 For Each cl In .Columns(1).SpecialCells(2)
   Sheets("blad2").Cells(cl + 1, Asc(UCase(cl.Offset(, 1))) - 63).Interior.ColorIndex = 6
 Next cl
  End With
End Sub

 

[Klijhoofd]

Hoi Harry,

Dat werkt als een tierelier! Precies zoals ik het wilde de groene kleur die ik heb was 4, dus dat heb ik even gewijzigd.

Bedankt alvast!

Ik heb nog wel een vraag. Ik heb de VBA nu aan een button gehangen, dus als ik daar op klik gaat de VBA lopen. Als ik echter op de button klik, daarna de letters op blad 1 verander en vervolgens weer klik, dan blijft de "oude" waarde staan. Er zou eigenlijk een regel toegevoegd moeten worden dat hij het bereik eerst weer helemaal ongekleurd maak. Welke regel kan ik daarvoor invoegen?

Ik heb zelf al wat geknutseld (en ga daar nog even verder mee), maar het wil nog niet echt lukken.

Nogmaals dank!

Gr

Tom

 

[HSV]

Het stond er al in, maar verwees naar het verkeerde blad.

Sub hsv()
Dim cl As Range
With Sheets("blad2")
   .UsedRange.Interior.ColorIndex = xlNone
 For Each cl In Sheets("blad1").Columns(1).SpecialCells(2)
   .Cells(cl + 1, Asc(UCase(cl.Offset(, 1))) - 63).Interior.ColorIndex = 6
 Next cl
  End With
End Sub

 

[Klijhoofd]

Super! Bedankt!

Ik heb zelf weinig kaas gegeten van VBA en ik merk dat ik er ook niet veel wijs uit word. Heb je tips om meer over dit onderwerp te leren? Titels van boekjes oid?

En wellicht kun je me nog een beetje op weg helpen met het wijzigen van het bereik. In het document waar ik het in ga gebruiken zijn de velden namelijk elders gepositioneerd en ik krijg het niet voor elkaar om dat te veranderen...

Blad 1:
A2:A11 = B3:B1256
B2:B11 = E3:E1256

Blad 2:
A2:A11 = A3:A387
B1:K1 = E2:CM2

Het gegevensbereik van de matrix (waar de groene vakjes moeten komen) is E3:CO387

Is die exersitie mogelijk?

 

[HSV]

Doe je bestandje er eens bij als je wil, want hier word ik niet veel wijs uit.

 

[Klijhoofd]

Nou... het is gelukt om hem zo te comprimeren dat ik hem nog kon uploaden... 100kb is zelfs voor dit bestand nog te weinig...

Ik heb alle data eruit gesloopt omdat het "vertrouwelijk" info bevat. Verder staan alle rijen en kolommen op dezelfde plek als in het origineel, dus als dat gelijk kan blijven, dan heel graag. Zo niet, dan moet ik in mijn eigen document even knutselen en schuiven.

 

[HSV]

Zoiets Tom?

Sub hsv()
Dim cl As Range
With Sheets("blad1")
   .UsedRange.Interior.ColorIndex = xlNone
 For Each cl In Sheets("blad2").Columns(2).SpecialCells(2)
 If cl.Offset(, 3) <> vbNullString Then
    .Cells(.Columns(1).Find(cl).Row, .Range("E2:CM2").Find(cl.Offset(, 3)).Column).Interior.ColorIndex = 6
  End If
    Next cl
  End With
End Sub

 

[Klijhoofd]

Hoi Harry,

Excuses voor mijn late reactie.

Ik heb hem geprobeerd en hij doet het. Er zit echter nog wel een foutmelding in...

Sub hsv()
Dim cl As Range
With Sheets("blad1")
   .UsedRange.Interior.ColorIndex = xlNone
 For Each cl In Sheets("blad2").Columns(2).SpecialCells(2)
 If cl.Offset(, 3) <> vbNullString Then
    .Cells(.Columns(1).Find(cl).Row, .Range("E2:CM2").Find(cl.Offset(, 3)).Column).Interior.ColorIndex = 4       [COLOR="#FF0000"]<------ Hier zit een fout in. Door de fout werkt de macro tot regel 64... Daaronder plaatst hij geen groeneblokjes meer...[/COLOR]  End If
    Next cl
  End With
End Sub

 

[HSV]

Zo dan Tom?

Sub hsv()
Dim cl As Range, c as range
With Sheets("blad1")
   .UsedRange.Interior.ColorIndex = xlNone
 For Each cl In Sheets("blad2").Columns(2).SpecialCells(2)
 If cl.Offset(, 3) <> vbNullString Then
   set c =  .Cells(.Columns(1).Find(cl).Row, .Range("E2:CM2").Find(cl.Offset(, 3)).Column)
If not c is nothing then
   c.Interior.ColorIndex = 4
end if
  End If
    Next cl
  End With
End Sub

 

[OctaFish]

Zonder programmeren is het natuurlijk ook meer dan prima te doen met voorwaardelijke opmaak (ja, dat kan wel degelijk) samen met een formule als je tekst wilt in een cel.
Formule: =ALS(C$1=$B2;"x";"")
Voorwaardelijke opmaak:=C$1=$B2
Ik heb voor het gemak de matrix op hetzelfde blad gezet vanaf kolom C, maar het werkt natuurlijk ook goed met twee werkbladen. Waarom programmeren als het met een hele simpele formule kan?

 

[Klijhoofd]

Hoi HSV,

Ik krijg nu de volgende foutmelding in dezelfde regel.

 

[Klijhoofd]

@ Octafish

Ik begrijp dat wanneer programmeren niet mogelijk is, dat het beter is om op een andere wijze op te lossen. Echter ik denk dat je niet helemaal begrijpt wat ik bedoel.

Huidige situatie: Matrix met kruisjes (platte "X" zonder achterliggende code)

Gewenste situatie: Op basis van 2e sheet worden overeenkomende vakjes in de matrix groen gemaakt met behoud van de "x-jes" uit de huidige situatie. Met andere woorden: de "X-jes" hebben als doel om de oude situatie weer te geven. De groene vakjes geven de nieuwe situatie weer.

 

[Haaren101]

Dan hoef je alleen maar de voorwaardelijke opmaak van @Octafish te gebruiken. Dat laat de X gewoon staan en kleurt alleen de cel

Ron

 

[OctaFish]

Ik begrijp dat wanneer programmeren niet mogelijk is, dat het beter is om op een andere wijze op te lossen.

Ik mag toch hopen dat je het andersom bedoelt....

 

[HSV]

Hoi HSV,

Ik krijg nu de volgende foutmelding in dezelfde regel.

In het door jouw meegezonden voorbeeldbestand krijg ik geen foutmeldingen Tom.

 

[Klijhoofd]

Hoi Harry,

Ik heb inmiddels ontdekt waarom hij tot regel 64 invulde. Ik had op die plek een item staan die niet overeenkwam met een item in de lijst. Dan is het logisch dat hij stopt.

Ik krijg nog steeds een foutmelding (91), maar de macro werkt wel gewoon.

Bedankt voor je hulp! Scheelt ENORM veel werk!!

 

[HSV]

Er staan waarschijnlijk verkeerde waarden in kolom E van blad2.
Vul de rode regelcodes even toe, ben je van de melding af.

[COLOR=#FF0000]On[/COLOR] [COLOR=#FF0000]Error Resume Next[/COLOR]
   Set c = .Cells(.Columns(1).Find(cl).Row, .Range("E2:CM2").Find(cl.Offset(, 3)).Column)
If Not c Is Nothing Then
  c.Interior.ColorIndex = 6
End If
[COLOR=#FF0000]On Error GoTo 0[/COLOR]