regels selecteren indien aan een voorwaarde voldaan

Status
Niet open voor verdere reacties.
S

Sjaakz

Gebruiker
Lid geworden
3 jun 2009
Berichten
120
Heren dames,

Graag wil ik automatisch regels selecteren. Ik heb een urenlijstje waarbij in de laatste kolom het dossiernr vermeld staat.

Indien bijvoorbeeld de 3 regels hetzelfde dossiernr hebben selecteer ik deze drie regels met de hand en start vervolgens mijn code.
(knippen/openen dossier/plakken enz).

Nu wil ik dat VBA zelf kijkt of de dossiernrs hetzelfde zijn en de selectie voor mij maakt. Zodat ik wanneer deze instructie goed werkt de andere code eraan vast kan plakken en helemaal niets meer hoeft te doen.Bekijk bijlage automatisch selecteren.xlsm

Ik heb een simpel voorbeeldje bijgevoegd zoals je ziet kan de selectie slechts één regel zijn maar het kunnen er ook meerdere zijn.

Alvast bedankt weer voor het snelle antwoord
Groet SjaakZ
 
Een bestaande code vastplakken aan een nieuwe code is volgens mij nog nooit iets goeds uit voort gekomen. Wat is uiteindelijk de bedoeling?
 
toelichting........

hoi Spaarie

Sorry dat het "wat" onduidelijk was :o:o

Een beetje achtergrond: ik heb de urenverantwoording van zo'n 30 collega's in een lijst ingevoerd dit is uiteindelijk zo'n 600 dossier regels. Deze lijst kopieer ik en sorteer ik oa op dossiernr op het volgende tabblad en vanaf hier gaat alles spelen.

Wat ik nu doe is de regels met het zelfde dossiernr handmatig selecteren en daarna start ik handmatig de macro om de betreffende regels te knippen en te plakken in het betreffende dossier na verwerking worden de nu lege regels verwijderd.

Dan stop de code weer omdat ik het nog niet voor elkaar heb de regels op dossier te laten selecteren. Als ik dat selecteren gedaan heb dan start ik weer de code.
De geknipte regels worden verwijderd en na zo'n 600 regels is de lijst "op".:shocked::p

Dus kort gezegd:

Selecteren (op dossiernr) in het voorbeeld regel 2 3 en 4
Knippen
plakken
verwijderen

de volgende regel(s) selecteren in het voorbeeld regel 5 (door het verwijderen van de regels na afloop vd code is het natuurlijk niet meer regel 5 maar regel 2 geworden)
knippen
enz
enz

de volgende regels selecteren 6 en 7. (wederom door het verwijderen is dit nu regel 2 en 3 geworden)
knippen plakken


Waarbij ik de code voor het knippen plakken en verwijderen al gemaakt heb alleen voor het selecteren heb ik nog geen tijd gehad.

Mijn doel is dat ik met één keer de code starten heel de lijst foutloos kan laten verwerken.

Groet SjaakZ
 
bedankt spaarie maar.......

bedankt spaarie :thumb: top dat je de moeite hebt genomen hier even voor mij naar te kijken.

Maar ik krijg het document niet geopend gedownload :evil: :mad:we hebben een nieuwe automatiseerder die kennelijk de teugels wat aangehaald heeft:(. Vanavond ga ik thuis even kijken en je hoort morgen van me.

Ik ga nu eerst even de automatiseerder even wat vertellen.:D

In ieder geval bedankt :thumb:
SjaakZ
 
Spaarie bedankt maar........

Goedemorgen Spaarie,

Bedankt voor de hulp, maar kan je mij als leek :o misschien een beetje toelichten wat nu iedere regel doet :shocked:. Het is nl grotendeels wat ik wil en zo kan ik de code zelf aanpassen.

Ik weet dat het een voorbeeld is van jou maar de code moet alleen de betreffende regels te selecteren zodat daarna de volgende code kan starten.
wanneer deze code klaar is dan begint de code weer opnieuw net zo lang tot de lijst weg gewerkt is.

Alvast bedankt weer voor je snelle antwoord.:thumb:
Groet SjaakZ
 
Goedemorgen Sjaakz,

Wat ik probeer duidelijk te maken is dat er meer wegen naar Rome leiden. Ik ben namelijk van mening dat hetgeen wat je wilt realiseren veel makkelijker is en kan met 1 module.
Ik probeer je los te weken, zeg maar, van het idee dat je iets moet selecteren en vervolgens je code handmatig weer moeten starten.

Maar als je alleen wilt dat de module selecteert dan pas ik het wel aan voor je...

Uitleg van de code staat er bij:
Code: 
Sub Spaarie()
    With Sheets(1)
        'elke waarde in een gevulde cel in kolom C
        For Each d In .Columns(3).SpecialCells(2).Offset(1).SpecialCells(2)
            'unieke waardes verzamelen
            If InStr(dossier, d.Value) = False Then dossier = dossier & "|" & d.Value
        Next
        
        'voor elke waarde in de unieke waardes
        For Each x In Split(Mid(dossier, 2), "|")
            'aan het eind tabblad toevoegen met 1 van de unieke waardes als naam
            Sheets.Add(, Sheets(Sheets.Count)).Name = x
            'filter kolom C op tabblad 1 op de unieke waardes en kopieer deze naar het zojuist gemaakte blad
            With .Cells.CurrentRegion
                .AutoFilter 3, x
                .Copy Sheets(x).Range("A1")
            End With
        Next
        .AutoFilterMode = False
    End With
End Sub
 
Laatst bewerkt:
dat losweken is prima

Spaarie bedankt voor je toelichting,

Dat is natuurlijk ook prima en denk misschien beter zelfs. Dat kopiëren en aanmaken van tabbladen kan ik natuurlijk vervangen door mijn vervolg code.

Zelf ben ik van mening dat ik domweg de formule kan overnemen en een beetje kan aanpassen naar het echte document maar dan leer ik het nog niet, omdat ik niet weet wat ik gedaan heb.
Wanneer ik dan volgende week weer zoiets heb dan moet ik weer bij jou (of helpmij) aankloppen. Het is mijn wens om in de toekomst zelf ook hulp te bieden. (ook al ben ik daar nog ver vandaag :D)

Ik zie dat je een filter maakt op kolom C en vervolgens worden de resultaten naar een nieuw gemaakt tabblad gekopieerd.

Graag wil ik weten wat er oa bedoelt wordt met specialcells en "l", d.value enz enz ja ja je hebt te maken met echte dombo sorry :o

Groet SjaakZ
 
Misschien als je de vervolgcode plaatst kan ik er al wat mee...

Maar inderdaad, met het zomaar overnemen van de code leer je niet erg veel. Daarom is het ook goed om eens met de F8 toets stap voor de stap door de code heen te gaan en kijken wat er gebeurt.
Wanneer je vragen hebt, volgende week of volgende maand, kan je altijd op HelpMij aankloppen. Dit is beter omdat je indirect toch mensen helpt die met een soortgelijke vraag zitten.

.Columns(3).SpecialCells(2).Offset(1).SpecialCells;
Met SpecialCells kan ik, in dit geval, in kolom C bepaalde cellen makkelijk selecteren die voldoen aan de criteria 2 oftewel xlCellTypeConstants. Dit houdt in dat alle cellen met een waarde geselecteerd worden.
In dit geval ook de kolomnaam en daar komt is de Offset(1) voor. Dit betekent 1 regel schuiven, maar dan komt er onderin ook een cel bij. Vandaar dat ik weer .SpecialCells(2) ingeef zodat deze extra lege cel weer verdwijnt.

d.value:
De 'd' is het bereik in mijn For-Next loop zoals je ziet in de code. 'For Each d'...
De variabele cellen in kolom C krijgen hiermee een naampje om het zo te zeggen (in dit geval een d). Dit had net zo goed a, b, c, w ofzo kunnen zijn. Wanneer je leert programmeren declareer je deze waarde als Range; 'Dim d as Range'
Het declareren doe ik niet zo vaak, maar af en toe moet het. Waarom ik .Value gebruik is omdat het nu een object is en die wil ik niet hebben. Ik wil alleen de waarde van het object en dat krijg ik met .Value.

"|":
De pipeline gebruik ik in de string 'dossier' als een scheidingsteken. 'dossier' wordt een samenvatting van unieke waardes in kolom C en om deze makkelijk te kunnen scheiden (For Each x In Split(Mid(dossier, 2), "|")).
In dit geval is 'x' weer een variabele en niet een range ;)

Pfff... moeie vingers...

Tip: gebruik de F1 toets in Excel. Daar kan je heel veel vinden en natuurlijk is Google je beste vriend.
 
Vervolg code

Spaarie,

Ik ga nu eerst even mijn werk afmaken en in de loop vd ochtend zet ik even de uitgeklede code op helpmij. (omdat het anders nodeloos ingewikkeld wordt)

Groet SjaakZ
 
de code

Spaarie,

Zoals gemeld een uitgedunde code.

Code: 
Sub bestandopenen()

'
'Maakt normaal de keuze of het dossier gereed is of niet
'


With CreateObject("Scripting.FileSystemObject")
If .FileExists(Range("d1").Value & ".xlsm") = True Then openen
End With

End Sub
Sub openen()

'
'   Knipt de geselecteerde uren opent een actief bestand en plakt de uren in het tabblad uren
'   op de laatste regel

    Selection.Cut
    Workbooks.Open Filename:=Sheets("ONVERDEELD").Range("d1").Value & ".xlsm"
    Sheets("uren").Select
    ActiveCell.SpecialCells(xlLastCell).Select
    ActiveCell.Offset(2, -8).Range("A1").Select
    ActiveSheet.Paste
        
    sluiten
End Sub

    Sub sluiten()
' slaat het werk op en sluit het af verwijderd de lege geknipte regels
' en maakt de formule voor het nieuw op te halen dossier
    
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "=R[1]C[6]&"" ""&R[1]C[5]"
    
    adres
   End Sub
  Sub adres()
'
' geeft adres van het bestand
'
'
'
    Range("G2").Select
    Selection.Copy
    Workbooks.Open Filename:="P:\Werken\mapindeling.xlsx"
    Range("a1").Select
    ActiveSheet.Paste
    ActiveWindow.ActivatePrevious
    ActiveWindow.ActivatePrevious
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "=[mapindeling.xlsx]Blad1!R1C2&""\""&RC[-3]"
    Windows("mapindeling.xlsx").Activate
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=IF(R[1]C/1>1,1,"""")"
    Application.DisplayAlerts = True
    Rows("2:2").Select
End Sub

Ik hoop dat het een beetje duidelijk voor je is.

Kortweg
1 ik selecteer de te knippen regels (handmatig)
2 start de code en deze
3 knipt de regels
4 opent het bestand
5 plakt de geknipte regels op de gewenste plaats
6 slaat het bestand op en sluit het af
7 verwijdert de lege geknipte rijen
8 laat de nieuwe bestandsnaam zelf samenstellen

Ongetwijfeld kan het korter maar dat is voor latere zorg

Groet SjaakZ
 
Laatst bewerkt:
Heb je een fictief bestandje (gebaseerd op het echte bestand natuurlijk) waar het tabblad 'onverdeeld' in zit en het bron bestand waar alle uren in staan?
Want wat staat er in D1 dat het bestand geopend wordt, etc.
 
andere optie

Spaarie,

Het lukt me niet om een voorbeeld bestandje te maken. Er zijn wat te veel verwijzingen naar andere bestanden (adressen).

Zelf heb ik met jou idee van filteren zitten spelen en denk dat ik met mijn zeer beperkte kenis een deel van mijn oplossing gevonden heb.

De filter selecteert de betreffende regels, via een hulp tabblad, worden de regels naar mijn bestand geknipt (nu nog binnen het werkblad) en geplakt.
Ik krijg het alleen niet voor elkaar om de eerder gekopieerde regels uit de lijst te verwijderen.


Code: 
Sub Macro1()
'
' Macro1 Macro
'
    Columns("A:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("A:C").AutoFilter Field:=3, Criteria1:=Range("e11").Value 'e11 wordt steeds opnieuw ingegeven 
    Cells.Select
    Selection.Copy
    Sheets("teknippen").Select
    ActiveSheet.Paste
    'hier komt mijn bestaande code nog wel aan te passen
    bestaandecode
    ActiveSheet.Previous.Select
    Selection.AutoFilter

End Sub

Sub bestaandecode()
'
' Dit zou mijn bestaande code kunnen zijn
' nog wel aan te passen natuurlijk

'
    Selection.Cut
    Sheets("dossier").Select
    ActiveSheet.Paste
    ActiveSheet.Previous.Select
End Sub

Als je in jou voorbeeld twee tabbladen wil aanmaken (eerst teknippen en dan dossier) en de code wil kopiëren moet het lukken. (afgezien van een paar schoonheidsfoutjes):confused:

Nadat ik ruzie gemaakt heb met de automatiseerder kan ik nu geen bestanden meer uploaden sorry :evil: ik kan wel weer downloaden.

Stilletjes hoop ik dat jij de oplossing weet om de eerder gekopieerde regels te verwijderen :rolleyes:.

Alvast bedankt weer voor je antwoord
SjaakZ
 
Welke bestand moet er geopend worden, hoe heet deze? Wat is de locatie van dit bestand? Wat staat er in D1? Wat staat er in E11?
Die hele soep code kan vervangen door 1 simpele module, maar dan heb ik info nodig. Ranges die je gebruikt in je codes, waarvan ik de 2e code trouwens als niet verzonden beschouw want daar kan ik helemaal niks mee.

Als het uploaden hier niet lukt wellicht lukt het uploaden naar mijnbestand.nl. Je hoeft je bestaande bestand niet aan te passen, maar maak een klein opzetje maken hoe het er uit ziet en wat er moet gebeuren ben ik tevreden mee...
Op deze manier zijn we er volgende week nog mee bezig.

P.S. ik weet wel hoe je die regels moet verwijderen, maar ik wil je voorzien van een goede stabiele code en niet houtje-touwtje-geknutseld-doe-het-zelf-in elkaar zet-Ikea code.
 
Spaarie

Hoi Spaarie, Sorry dat ik wat later antwoord. Maarre Wat is er mis met mijn houtje touwtje Ikea geknutselde code....... haha

Door jou ben ik op het spoor gezet van filteren en heb vervolgens de code grotendeels opgenomen met de recorder.

Het voordeel hiervan is dat ik zelf precies weet wat er gebeurt en dat ik het zelf kan onderhouden en aanpassen wanneer er dingen veranderen.

Ik ben blij dat je me geholpen hebt en waardeer het dat je zelfs nog verder wilde gaan maar gistermiddag heb ik ook het laatste stukje gevonden en nu......... draait de code voor mij als een zonnetje.

Nogmaals bedankt :thumb::thumb::thumb:
Groet SjaakZ
 
Helemaal super dat je het zelf voor elkaar hebt gekregen. Misschien dat je de code kan plaatsen en dat er misschien wat geoptimaliseerd kan worden of iets dergelijks...
 
de code

De code is nog in de afwerkfase/aanpasfase :D

ik kwam erachter dat ik nog naar de tandarts moest en vandaag heb ik al mijn werk moeten inhalen wat ik gisteren deels verspeeld heb met het maken van deze code

Code: 
Sub Macro1()
'
' Macro1 Macro
'

'
    Columns("A:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("A:C").AutoFilter Field:=3, Criteria1:=Range("dossier").Value
    Cells.Select
    Selection.Copy
    Sheets("teknippen").Select
    Range("a1").Select
    ActiveSheet.Paste
    'hier komt mijn bestaande code nog wel aan te passen
    bestaandecode
    ActiveSheet.Previous.Select
    Selection.Delete Shift:=xlUp
  
    Range("a1").Select
    ActiveWorkbook.Names("dossiernummer").Delete
   
    ActiveCell.Rows("1:1").EntireRow.Select
    Selection.Insert Shift:=xlDown
    Range("c1").Select
    ActiveWorkbook.Names.Add Name:="dossiernummer", RefersToR1C1:="=onverdeeld!R1C3"
    ActiveCell.FormulaR1C1 = "=R[1]C"
    ActiveCell.Select
    kleur

End Sub

Sub bestaandecode()
'
' Dit zou mijn bestaande code kunnen zijn
' nog wel aan te passen natuurlijk

'
    Selection.Cut
    Sheets("dossier").Select
    ActiveSheet.Paste
    ActiveSheet.Previous.Select
End Sub

Sub kleur()
'
' Macro11 Macro
'

'
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
End Sub


Alvast bedankt dat je je blik erop wil werpen. Scheelt mij natuurlijk ook weer.

Prettige avond
SjaakZ
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan