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

Zoeken en opsommen

Status
Niet open voor verdere reacties.

tonissteiner

Gebruiker
Lid geworden
17 sep 2008
Berichten
337

Beste,

in bijlage een bestand waarmee ik mijn vraag wil verduidelijken. Dit bestand is een uitreksel (tabblad) van een bestand waarmee onze uren, verlofdagen etc worden bijgehouden. Op dit tabblad worden de data welke een bijzondere dag zijn (uitleg onderaan) automatisch ingekleurd vanuit andere tabbladen met de functie vertikaal zoeken. nu zou ik graag nog voor onze verlofdagen een opsomming krijgen onderaan in de tabel. Als voorbeeld heb ik de data 21 juli t/m 25 juli ingevuld met de "v" van verlofdag. Hoe kan ik verkrijgen dat deze data nu onderaan in de tabel "opgenomen verlofdagen" automatisch worden ingevuld?

Hopelijk duidelijk genoeg omschreven?

Thx
 

Bijlagen

  • Uren - 2008.xls
    97 KB · Weergaven: 53
tonissteiner

Ik heb eerst een vraag voor jou. Weet je wat het Worksheet_Change eigenlijk is?

Dat is code die uitgevoerd wordt vanaf dat er ergens in het blad een cel of cellen gewijzigd worden.

En als dat gebeurt, maak jij een lus doorheen het bereik F6:AD64. Dus een kleine 1.500 cellen...

Je kan ook Resize gebruiken:

Code:
cel.Offset(0, 0).Interior.ColorIndex = 43
cel.Offset(-1, 0).Interior.ColorIndex = 43

wordt dan

Code:
cel.Offset(-1, 0).Resize(2,1).Interior.ColorIndex = 43

Wigi
 
'lo Wigi,

nope wist ik niet. ben maar een leek en haal mijn info her en der. bedankt voor je verduidelijking, ben vandaag weer een beetje slimmer geworden ;o)
 
Exel - zoeken en opsommen

Hmmm, blijkbaar is mijn probleem dat ik hier poste op 11/11 met als onderwerp "zoeken en opsommen" onder de knappe bollen van jullie toch niet zo simpel uitgaande van de reacties die ik kreeg.
ziet niemand zich hier echt man/vrouw over om dit probleem op te lossen?
 
Gelet op de naam die ik las als de man die jou advies gaf, kon je het eigenlijk niet beter treffen. Wigi is één van dé deskundigen op Excel gebied.
 
100% gelijk. maar ik vrees dat oftewel hij de vraag een beetje uit het oog verloren had of er (nog) geen tijd voor gehad heeft. daarom hoopte ik dat één van die andere deskundigen mij zou kunnen helpen. vandaar dat ik mijn vraag nog even ter herinnering bracht.

alvast bedankt voor je reactie
 
Dan kun je mogelijk beter in je oospronkelijke topic een reply typen, dan krijgt Wigi een mailtje.
 
Vooraleer dat er gekeken wordt naar dat V probleem, zet hier maar eens eerst een geüpdate versie na de tips die ik hierboven aangaf. O.a. geen lus doorheen 1500 cellen elke keer dat je iets wijzigt. Bekijk andere topics over die Worksheet_change event, en dan vooral wat Target is.
 
Ik bedoelde eigenlijk geen pb of mail, maar gewoon een reply in het topic. Dan hoor jij toch een mailtje te krijgen via je provider, of heb je dát uitgezet?
 
Laatst bewerkt:
Twee topics samengevoegd. Het is niet de bedoeling om twee keer je vraag te posten.
 
ok huijb, ik snap je probleem. sorry voor de overlast

wigi, nogmaals bedankt. bij deze heb ik het dus aangepast (althans ik hoop dat ik het begrepen heb en goed aangepast heb)

zie je het zitten (of iemand anders) om nog even te kijken naar mijn oorspronkelijke vraag?
 

Bijlagen

  • Uren - 2008(2).xls
    96 KB · Weergaven: 34
ok huijb, ik snap je probleem. sorry voor de overlast

wigi, nogmaals bedankt. bij deze heb ik het dus aangepast (althans ik hoop dat ik het begrepen heb en goed aangepast heb)

zie je het zitten (of iemand anders) om nog even te kijken naar mijn oorspronkelijke vraag?

en? ziet niemand er zich man over dan?
 
en? ziet niemand er zich man over dan?

Waar zie ik jouw stukken code die je al geprobeerd hebt? Ook al werken die dan nog niet, je kan altijd proberen en op het forum zoeken. Een lus doorheen een bereik is al vaak gedaan geweest (staat zelfs nog in de code van het Worksheet_Change event...)

Haal tevens de samengevoegde cellen eruit, die zorgen bijna altijd voor problemen.
 
Laatst bewerkt:
goede morgen Wim,

ik moet eerlijk zijn dat ik nog niks geprobeerd heb. ik weet gewoon niet hoe ik er moet aan beginnen zoiets te schrijven in VB. ook na mijn zoektocht hier op dit forum ben ik niet veel wijzer geworden. eigenlijk ben ik maar een simpele leek op gebied van ewel hoor. en wat je juist met die lus bedoeld snap ik ook niet echt. ik had gehoopt dat ik die er na jouw hulp van vorige keer uitgehaald heb

mvg
 
Deze code heb je al:

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    'F6:AD64

        'betaalde feestdag ( bf ) = licht groen(43)

        'verlof Background ( v ) = licht oranje(36)

        'recup Background ( r ) = licht blauw(34)

        'ziek 444 Background ( z ) = licht paars(15)
        
        'collectief verlof Background ( cv ) = donkergeel (12)
        
        ' uitzonderlijk verlof Background ( uv ) = roze (38)
        
        ' vervangingsdag betaalde feestdag Background ( vbf ) = groen (31)
          
    Dim cel As Range

    For Each cel In Range("F6:AD64").Cells
            
        If cel.Value <> "" Then

            If cel.Value = "bf" Then
    
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 43
                                
                    ElseIf cel.Value = "v" Then
        
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 36
                                
                    ElseIf cel.Value = "r" Then
                        
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 34
        
                    ElseIf cel.Value = "z" Then
                    
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 15
             
                    ElseIf cel.Value = "cv" Then
                    
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 12
                    
                    ElseIf cel.Value = "uv" Then
                    
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 38
                    
                    ElseIf cel.Value = "vbf" Then
                    
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 31
                    
                    ElseIf cel.Value = " " Then
                    
                        cel.Offset(-1, 0).Resize(2, 1).Interior.ColorIndex = 0
                                     
             End If
             
        End If
        
   Next

End Sub

Wat gebeurt daarin? Een lus doorheen alle cellen van het bereik F6:AD64, en afhankelijk wat er dan in die cellen staat (cv, uv, vbf, ...) doe je iets anders.

Jij moet nu voor de verlofdagen ook een lus hebben, en als er een v in de cel staat moet je iets anders doen. Dit stuk moet zelf zeker doenbaar zijn, de rest zullen helpers dan wel doen.

De code komt in een gewone Module (Invoegen > Module), dus geen Worksheet_Change event.

Wigi
 
ik heb in een vorige topic op datum van 13-12-2004 nog iets gevonden waar ik probeerde op verder te bouwen maar kom er niet uit. mijn VB kennis is echt nihil. de codes die daar gebruikt worden heb ik proberen omzetten maar kom er niet uit. in de eerste plaats wordt de macro al niet automatisch gestart. wat ik teruggevonden heb is:

Sub opsomming()

Dim groepen(200, 100)
'groepen bepalen
For r = 2 To 166
For k = 4 To 11
groep = Sheets("Gebruikers en groepen").Cells(r, k).Value
'groep zoeken in matrix
bestaande_groep = False
For g = 1 To 100
If IsEmpty(groepen(0, g)) And (Not IsEmpty(groepen(0, g - 1)) Or g = 1) Then laatste_groep = g
If groep = groepen(0, g) Or IsEmpty(groep) Then 'groep komt al voor
bestaande_groep = True
Exit For
End If
Next g
If bestaande_groep = False Then
groepen(0, laatste_groep) = groep
End If
Next k
Next r
Sheets("blad2").Range("A1:cf200").Value = groepen
'nu een matrix met alle voorkomende groepen gemaakt, nu kan er per groep een medewerker ingevuld worden

For r = 2 To 166
naam = Sheets("Gebruikers en groepen").Cells(r, 1).Value
For k = 4 To 11
groep = Sheets("Gebruikers en groepen").Cells(r, k).Value
If IsEmpty(groep) Then GoTo skip
'zoeken waar deze groep in de matrix staat en naam daaraan toevoegen
toegevoegd = False
For g = 1 To 100
If toegevoegd = True Then Exit For
If groepen(0, g) = groep Then
'zoeken naar eerste lege waarde in matrix
For namen = 1 To 200
If IsEmpty(groepen(namen, g)) And (Not IsEmpty(groepen(namen - 1, g))) Then
test = groepen(0, g)
groepen(namen, g) = naam
toegevoegd = True
Exit For 'naam is toegevoegd aan matrix
End If
Next namen
End If
Next g
skip:
Next k
Next r

Sheets("blad2").Range("A1:cf200").Value = groepen
MsgBox ("Klaar !!")
Worksheets("Blad2").Activate
Range("A1").Activate

End Sub

ik heb die aangepast naar:

Sub opsomming()

'nu een matrix met alle voorkomende groepen gemaakt, nu kan er per groep een medewerker ingevuld worden

For r = 6 To 64
naam = Sheets("Kalender").Cells(r, 1).Value
For k = 5 To 30
v = Sheets("Kalender").Cells(r, k).Value
If IsEmpty(v) Then GoTo skip
'zoeken waar v in de matrix staat en datum daaraan toevoegen
toegevoegd = False
For g = 1 To 100
If toegevoegd = True Then Exit For
If groepen(0, g) = groep Then
'zoeken naar eerste lege waarde in matrix
For namen = 1 To 200
If IsEmpty(groepen(namen, g)) And (Not IsEmpty(groepen(namen - 1, g))) Then
test = groepen(0, g)
groepen(namen, g) = naam
toegevoegd = True
Exit For 'naam is toegevoegd aan matrix
End If
Next namen
End If
Next g
skip:

Next r

End Sub


kan ik hiermee verder werken of zit ik nu al op een verkeerd spoor?
 
zie bijlage

Wigi
 

Bijlagen

  • Copy of Uren - 2008(2).xls
    99 KB · Weergaven: 38
Thx Wim, het zit in de goede richting. echter:
1. de macro loopt bij mij nog niet automatisch en als ik hem uitvoer dan geeft hij mij een foutmelding
2. de datum is niet juist. hij staat op 2/01/1202 terwijl het 01/01/2008 zou moeten zijn (zie de datum die erboven staat)
3. de letters v die ik al ingevuld heb staan ook niet in de lijst (week 30, maw 21/07/2008 t/m 25/07/2008
4. je schreef:
For kolom = 6 To 25
me dunkt dat dit tot 30 moet zijn
5. en dan snap ik nog niet waarom je hier een O gebruik
If Cells(rij, kolom) = "v" Then _
Range("O" & Rows.Count)

maar toch alvast nogmaals bedankt om je tijd hierin te steken
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan