• 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.

visual basic in excel

Status
Niet open voor verdere reacties.

anansie

Gebruiker
Lid geworden
1 apr 2003
Berichten
313
Ik heb onderstaande macro gemaakt in visual basic. Echter is het probleem dat bij de optelling van de kleuren blauw en groen altijd een waarde van 1 wordt aangehouden. Hoe maak ik het zo dat in in bepaalde cellen onafhankelijk van kleur standaard een aftrek plaatsvindt van 0.25 ?

' Start loop
For Rij = 2 To 45
Groen = 0
Rood = 0
Blauw = 0
Range("B" & Rij).Select
If ActiveCell.FormulaR1C1 <> "" Then
Range("C" & Rij).Select
Waardering
Range("D" & Rij).Select
Waardering
Range("E" & Rij).Select
Waardering
Range("F" & Rij).Select
Waardering
Range("G" & Rij).Select
Waardering
Range("H" & Rij).Select
Waardering
Range("I" & Rij).Select
Waardering
Range("J" & Rij).Select
Waardering
Range("K" & Rij).Select
Waardering
Range("L" & Rij).Select
Waardering
Range("M" & Rij).Select
Waardering
Range("N" & Rij).Select
Waardering
Range("O" & Rij).Select
Waardering
Range("P" & Rij).Select
Waardering
Range("Q" & Rij).Select
Waardering
Range("R" & Rij).Select
Waardering
Range("S" & Rij).Select


If Groen > 0 Then
ActiveCell.FormulaR1C1 = Groen + Blauw
End If

Range("T" & Rij).Select
If Groen > 0 Then
If Groen <= 5 Then
ActiveCell.FormulaR1C1 = Groen - 0.25
Else
ActiveCell.FormulaR1C1 = Groen - 0.5
End If
Else
ActiveCell.FormulaR1C1 = Groen
End If

End If
Next Rij
Range("A1").Select
End Sub

Public Sub Waardering()
If Selection.Interior.ColorIndex = 4 Then Groen = Groen + 1
If Selection.Interior.ColorIndex = 3 Then Rood = Rood + 1
If Selection.Interior.ColorIndex = 8 Then Blauw = Blauw + 1
End Sub
 
Het is mij nog even onduidelijk.

Als je het niet erg vindt, heb ik je code ter wille v.d. overzichtelijkheid even gestructureerd geordend. (End Sub heb ik trouwens weggelaten, omdat er ook geen Private Sub(.....) bestaat, maar dit is even niet van belang. Verder begrijp ik jouw vraag niet zo goed:

Echter is het probleem dat bij de optelling van de kleuren blauw en groen altijd een waarde van 1 wordt aangehouden.
Moet dit juist wel of niet?

Hoe maak ik het zo dat in in bepaalde cellen onafhankelijk van kleur standaard een aftrek plaatsvindt van 0.25 ?
Welke bepaalde cellen? Ik neem aan dat die bepaalde cellen aan een bepaalde voorwaarde moeten voldoen?

Code:
' Start loop 
For Rij = 2 To 45 
   Groen = 0 
   Rood = 0 
   Blauw = 0 
   Range("B" & Rij).Select 
   If ActiveCell.FormulaR1C1 <> "" Then 
      Range("C" & Rij).Select 
      Waardering 
      Range("D" & Rij).Select 
      Waardering 
      Range("E" & Rij).Select 
      Waardering 
      Range("F" & Rij).Select 
      Waardering 
      Range("G" & Rij).Select 
      Waardering 
      Range("H" & Rij).Select 
      Waardering 
      Range("I" & Rij).Select 
      Waardering 
      Range("J" & Rij).Select 
      Waardering 
      Range("K" & Rij).Select 
      Waardering 
      Range("L" & Rij).Select 
      Waardering 
      Range("M" & Rij).Select 
      Waardering 
      Range("N" & Rij).Select 
      Waardering 
      Range("O" & Rij).Select 
      Waardering 
      Range("P" & Rij).Select 
      Waardering 
      Range("Q" & Rij).Select 
      Waardering 
      Range("R" & Rij).Select 
      Waardering 
      Range("S" & Rij).Select 

      If Groen > 0 Then 
         ActiveCell.FormulaR1C1 = Groen + Blauw 
      End If 

      Range("T" & Rij).Select 
      If Groen > 0 Then 
         If Groen <= 5 Then 
            ActiveCell.FormulaR1C1 = Groen - 0.25 
         Else 
            ActiveCell.FormulaR1C1 = Groen - 0.5 
         End If 
      Else 
         ActiveCell.FormulaR1C1 = Groen 
      End If 
   End If 
Next Rij 

Range("A1").Select 


Public Sub Waardering() 
   If Selection.Interior.ColorIndex = 4 Then Groen = Groen + 1
   If Selection.Interior.ColorIndex = 3 Then Rood = Rood + 1 
   If Selection.Interior.ColorIndex = 8 Then Blauw = Blauw + 1 
End Sub

Dennis.
 
Anansie,

Ik heb je code niet getest (Er kunnen dus nog andere fouten in zitten), maar de fout die jij aangeeft is zeer simpel:
Uw Variabelen worden bij elke lus terug op 0 gezet:

' Start loop
For Rij = 2 To 45
Groen = 0
Rood = 0
Blauw = 0
Range("B" & Rij).Select
If ActiveCell.FormulaR1C1 <> "" Then
Range("C" & Rij).Select
Waardering
enz.

Dit moet dus zijn:


Groen = 0
Rood = 0
Blauw = 0
' Start loop
For Rij = 2 To 45
Range("B" & Rij).Select
If ActiveCell.FormulaR1C1 <> "" Then
Range("C" & Rij).Select
Waardering
enz.

Luc
 
Mijn probleem is dat ik 16 cellen heb (C t/m R) waarbij de macro zo is ingesteld dat het totaal aantal blauwe en groene cellen bij elkaar opgeteld worden. Elke cel heeft dus een waarde van "1". Dus per opgetelde cel is het dus +1. Nu wil ik bij een aantal cellen ipv +1 een andere waarde hebben, namelijk +0.25 en +0.75.
 
Goedemorgen,

Ik wil hier even opmerken dat je enkele variabelen gebruikt in verschillende macro's. (Groen; Rood; Blauw).

Indien je dat wil doen, moeten de variabelen gedeclareerd zijn boven uw Sub's. In de declaratiezone dus.

Luc
 
Ik begrijp het nog niet helemaal.
De variabelen in de verschillende macro's. Groen; Rood; Blauw, zijn goed. Alleen gaat deze steeds uit van 1. Ik wil dus voor de gehele C-Rij hebben dat deze uitgaat van 0.75.
 
Probleem is ook onduidelijk.

Jij wil voor de gehele C - rij ... enz.
C is een kolom.

Ik stel voor dat je de zaak eens naar me opstuurd.

Luc
 
Ik bedoel inderdaad de kolommen, sorry.
Hierbij zal ik een screenshot toevoegen.
Mijn wens is om de kolommen waarvoor geen heel uur wordt berekend, terug te brengen naar een kwartier (=0.25) of half uur (=0.50) en 3 kwartier (+0.75)
Alvast mijn hartelijke dank voor de moeite!!!
 
Laatst bewerkt:
Stuur het bestand (Excel) gewoon eens op naar mij:
lucheyndrickx@skynet.be

Ik hoop dat er niet te veel werk aan is, want ik heb het hier ontzettend druk. Maar het is vermoedelijk maar een kleinigheid.

Luc
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan