Als gelijk aan, dan kopiëren

[JeroenK]

Beste Helpers,

Ik ben bezig met een Single Data Entry systeem op het gebied van Taken, Verantwoordelijkheden en Bevoegdheden (TBV). Het doel is om in een TBV Matrix aan de hand van 5 verschillende variabelen aan te geven welke functie een bepaalde rol vervuld in een activiteit (voorbeeld in bijlage). Wanneer bij een bepaalde activiteit de functie x verantwoordelijk is (zodra er een "A" wordt ingevuld) moet de activiteit gekopieerd worden naar de functieomschrijving onder het onderdeel "A".

Wat eigenlijk de bedoeling is, is dat excel moet zoeken naar alle RASCI waarden in een bepaalde functie en deze kopiëren naar een nieuw blad.

Ik hoop dat het duidelijk genoeg omschreven is en dat jullie het antwoord weten!

Alvast hartelijk dank!
Met vriendelijke groet,


Jeroen Kesteloo

 

[WHER]

Gaat dit in de richting van wat je wilde?

 

[JeroenK]

Whow, dat is hem! Kun je misschien kort uitleggen wat er precies gebeurt? Ik snap er niet zo veel van... :shocked:

Met vriendelijke groet,


Jeroen Kesteloo

 

[danny147]

Beste JeroenK

Zie bestandje.

Groetjes Danny. :thumb:

 

[JeroenK]

Bedankt!! Ja dit is wel wat makkelijker voor de gebruiker als ik zou snappen wat er gebeurde... Ik snap dit eerlijk gezegd niet en kan het daardoor op dit moment lastig gebruiken. Ik ga toch de methode van WHER gebruiken.

Danny en WHER in ieder geval enorm bedankt voor de reactie en de moeite!!

Met vriendelijke groet,


Jeroen

 

[danny147]

Beste JeroenK

Hier zit gewoon een code achter die gemakkelijk te begrijpen is.

Sub Wegschrijven()
Dim cl As Range

  For Each cl In Sheets("TBV Matrix").Range("C7:C100")
  
  
    If cl = "R" Then cl.Offset(, -2).Resize(, 1).Copy Sheets("Quality Manager").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    If cl = "A" Then cl.Offset(, -2).Resize(, 1).Copy Sheets("Quality Manager").Cells(Rows.Count, 3).End(xlUp).Offset(1)
    If cl = "S" Then cl.Offset(, -2).Resize(, 1).Copy Sheets("Quality Manager").Cells(Rows.Count, 5).End(xlUp).Offset(1)
    If cl = "C" Then cl.Offset(, -2).Resize(, 1).Copy Sheets("Quality Manager").Cells(Rows.Count, 7).End(xlUp).Offset(1)
    If cl = "I" Then cl.Offset(, -2).Resize(, 1).Copy Sheets("Quality Manager").Cells(Rows.Count, 9).End(xlUp).Offset(1)
    
    Next
    
  For Each ck In Sheets("TBV Matrix").Range("D7:D100")
    
    If ck = "R" Then ck.Offset(, -3).Resize(, 1).Copy Sheets("General Manager").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    If ck = "A" Then ck.Offset(, -3).Resize(, 1).Copy Sheets("General Manager").Cells(Rows.Count, 3).End(xlUp).Offset(1)
    If ck = "S" Then ck.Offset(, -3).Resize(, 1).Copy Sheets("General Manager").Cells(Rows.Count, 5).End(xlUp).Offset(1)
    If ck = "C" Then ck.Offset(, -3).Resize(, 1).Copy Sheets("General Manager").Cells(Rows.Count, 7).End(xlUp).Offset(1)
    If ck = "I" Then ck.Offset(, -3).Resize(, 1).Copy Sheets("General Manager").Cells(Rows.Count, 9).End(xlUp).Offset(1)
    
    Next
    
End Sub

Neem nu de eerste regel.

  For Each cl In Sheets("TBV Matrix").Range("C7:C100")

Voor iedere cel (cl) in tabblad "TBV Matrix3 in het bereik C7:C100 gaan zoeken.

Tweede regel.

    If cl = "R" Then cl.Offset(, -2).Resize(, 1).Copy Sheets("Quality Manager").Cells(Rows.Count, 1).End(xlUp).Offset(1)

Cl (cel) moet "R" zijn dan waarde in cel A zoeken (cl.Offset(,-2)
R staat in Kolom C, dus -2 offset is Kolom A
1 cel kopiëren (Resize(,1).Copy Sheets
Deze Plakken in Tabblad ("Quality manager)
Waar: in Rij 1 (Rows.count, 1)
De volgende waarde wordt er dan onder gezet. (End(xlUp).Offset(1)

Ik hoop dat je het nu al een "beetje" begrijpt hoe de code in elkaar zit.

Groetjes Danny. :thumb:

 

[JeroenK]

Ja ik snap het wel :thumb: Maar hoe kom ik nu bij die text??

 

[danny147]

Beste JeroenK

Via ALT + F11

OF

Rechtermuisklik op je tabblad en code weergeven.

Dubbelklik op Module en daar staat ze.

groetjes Danny. :thumb:

 

[JeroenK]

Wat goed zeg! Ik ga me hier even in verdiepen! Super bedankt voor de uitleg!

Groet,


Jeroen

 

[WHER]

Wat betreft het begrijpen van de formule, denk ik dat de beste manier is om via de knop "Evaluate formula" te kijken hoe de formule zich stap voor stap afwikkelt, een tiental keer desnoods, en noteren wat elk deel van de formule doet.

 

[JeroenK]

Er gaat een wereld voor mij open. Ik ga zeker meer gebruik maken van de hulp hier, echt helemaal super!!

Bedankt jongens!

Met vriendelijke groet,


Jeroen