• 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 in meerdere bladen en resultaten verzamelen

Status
Niet open voor verdere reacties.
F

Figaro75

Gebruiker
Lid geworden
12 dec 2011
Berichten
91
Ik ben een redelijk beginnende excel gebruiker en ik probeer een urenverantwoording in excel te verbeteren en dan met name het zoeken op geboekte uren.

Het originele bestand bestaat uit 52 tabbladen met weken, een totaalstaat en een zoekblad. Men vult per dag in aan welk project ze werken en hoeveel uur. Daarnaast zijn er per project verschillende taken waarop geboekt kan worden. In het zoekblad wordt gebruikt gemaakt van de filters van excel. Hier worden alle regels van de voorgaande 52 weken gelinkt (koppeling).
We hebben meerdere mensen die allemaal een eigen bestand hebben en die rommelen af en toe wat af. Hierdoor werken de filters niet, vooral als mensen rijen knippen.

Nu kan excel waarschijnlijk veel makkelijker zoeken zonder last te hebben van gebruikers die rijen verwijderen. Ik zoek dus naar een manier om in alle weken te zoeken naar één projectnummer en dan een overzicht te krijgen van de rijen die beginnen met het projectnummer en de bijbehorende ingevulde uren.
Het mooiste zou zijn als er ook meteen een optelling is van alle uren.

Nu lukt het me wel om het projectnummer te vinden (code van Jan van Asseldonk), te selecteren en de achtergrond kleur te veranderen maar het lukt mij niet om de hele rij bij de gevonden cel te selecteren en deze over te halen naar het 'ZOEKEN' blad.

Ik heb al heel wat op dit forum gezocht maar kom er niet uit. Ik heb wat zoekfuncties via een userform gezien en dat zag er best mooi uit maar ik krijg het niet werkend.

Wie weet er een oplossing voor mijn 'probleem'??

Dus of alle gevonden rijen onder elkaar in het ZOEKEN-blad of een verzameling in een userform waar dan dus ook de zoekopdracht kan worden gegeven.
Bij het opnieuw zoeken mag het ZOEKEN-blad helemaal geleegd worden en dan weer opnieuw gevuld. Dat er zoekdata blijft staan is geen probleem.

Ik heb hier een uitgeklede versie geplaatst.
http://www.mijnbestand.nl/Bestand-NNL6JV8CDDVI.xls

Alvast bedankt voor het meedenken
 
Ik kom uit op deze code:

Code: 
Sub Zoeken()
'
' ZoekOp Macro
'
Dim zoek As String
Dim i As Integer
Dim resultaat As Range
Dim plakplaats As Range
Dim eerste As Range

    zoek = InputBox("Geef de te zoeken tekst op: ")
    If zoek = "" Then Exit Sub
    Application.ScreenUpdating = False

    For i = 1 To ActiveWorkbook.Worksheets.Count - 2
        With Sheets(i).Cells
        Set resultaat = .Find(What:=zoek, LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not resultaat Is Nothing Then
            Set eerste = resultaat
            Do
                Set plakplaats = Sheets("ZOEKEN").Range("a" & Sheets("ZOEKEN").Range("a65000").End(xlUp).Offset(1).Row)
                Sheets("ZOEKEN").Range(plakplaats, plakplaats.Offset(0, 10)).Value = Range(resultaat, resultaat.Offset(0, 10)).Value
                Set resultaat = .FindNext(resultaat)
            Loop While Not resultaat Is Nothing And resultaat.Address <> eerste.Address
        End If
        End With
    Next i
    Application.ScreenUpdating = True

End Sub
 
Bedankt, dit gaat de goede kant op maar ik heb toch nog een vraagje.

Ik heb de code als volgt aangepast om eerst het voorgaande zoekresultaat te wissen.
En dat werkt nu prima.

Code: 
Sub Zoeken()
'
' ZoekOp Macro
'
Dim zoek As String
Dim i As Integer
Dim resultaat As Range
Dim plakplaats As Range
Dim eerste As Range

    zoek = InputBox("Geef de te zoeken tekst op: ")
    If zoek = "" Then Exit Sub
    Application.ScreenUpdating = False

[COLOR="red"]    Sheets("ZOEKEN").Select
    Range("A2:K65000").Select
    Selection.ClearContents
    Range("A1").Select[/COLOR]

    For i = 1 To ActiveWorkbook.Worksheets.Count - 2
        With Sheets(i).Cells
        Set resultaat = .Find(What:=zoek, LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not resultaat Is Nothing Then
            Set eerste = resultaat
            Do
                Set plakplaats = Sheets("ZOEKEN").Range("a" & Sheets("ZOEKEN").Range("a65000").End(xlUp).Offset(1).Row)
                Sheets("ZOEKEN").Range(plakplaats, plakplaats.Offset(0, 10)).Value = Range(resultaat, resultaat.Offset(0, 10)).Value
                Set resultaat = .FindNext(resultaat)
            Loop While Not resultaat Is Nothing And resultaat.Address <> eerste.Address
        End If
        End With
    Next i
    Application.ScreenUpdating = True

End Sub

Kan ik echter de eerste gevonden rij ook lager op het blad "Zoeken" krijgen?
Dan zou ik daarboven misschien een filter kunnen instellen zodat ik de gevonden waarde ook kan sorteren op taak en gevulde uren.
Dit zou dan gevuld kunnen worden met de omschrijvingen zoals ook op alle weekstaten staat aangegeven.
Dus projectnummer, projectomschrijving, ma, di etc....

Ik heb al gerommeld in de offset maar dan krijg ik wel meer lege regels er tussen maar niet dat hij bv pas bij A5 begint met plakken. Ook het toevoegen van A5 bij de plakplaats werkte niet.
Wat doet Range "a" precies??
 
Dat kan, Je moet dan eerst je headers aanbrengen op het blad zoeken.

Ga naar zoeken, rij 4. Vul daar in: Projectnaam, dag, etc. Daarna gaat de macro automatisch goed

LET WEL: je moet wel je wiscode eerst aanpassen natuurlijk!

sheets("ZOEKEN").[a5:k65000].clearcontents

is ook een stuk korter dan de code die je nu hebt. Select is EVIL, je hebt het eigenlijk nooit nodig en maakt je code onwerkbaar en onvoorspelbaar.
 
Laatst bewerkt:
Bedankt wampier,

Als het projectnummer niet wordt gevonden wordt er nu niets geplakt.
Begrijpelijk maar zou er ook nog een messagebox getoont kunnen worden dat het project niet wordt gevonden?

Heb al geprobeerd met
Code: 
        If resultaat Is Nothing Then
        Show = MsgBox("Project niet gevonden", vbOK)
        End If

Maar dan krijg ik altijd de messagebox, of hij nu wel of niet wat vindt.
 
Je kunt eventueel een teller toevoegen. Het in de zoek loop zetten is inderdaad niet direct mogelijk, omdat de zoekfunctie per tabblad wordt uitgevoerd. Je kunt ook kijken of na de zoekfunctie rij5 nog steeds leeg is.
Code: 
if sheets("ZOEKEN").[a5].value = "" then
msgbox("zoekfunctie heeft niets gevonden")
end if

Dit kun je net boven de 'end sub' plaatsen. Overigens zoekt de functie nu alle cellen af. Indien je alleen kolom "A" wil doorzoeken moet je de scope iets aanpassen
 
Mijn baas vond dit al redelijk werken alleen kreeg ik de vraag of er ook kan worden aangegeven in welk blad de gevonden waarde werd gevonden.

Ik heb hier wel een bestand gevonden (extensive search.xls) maar daar wordt op een andere (uitgebreidere?) manier gezocht. In de eerste rij komt dan op het zoekblad steeds het blad(tab)naam en celnr als hyperlink.
Maar ik zou dan alleen de bladnaam hoeven te hebben. Een link is niet noodzakelijk omdat alle tabbladen gewoon zichtbaar zijn.

Dus als hij iets vind in week (tab) 12 dat hij dan die 12 ergens erbij zet.

Op dit moment laat ik de gevonden waarden ook meteen sorteren en bij een nieuwe zoekopdracht de sortering eerst uit zetten waarna hij het gevonden wist. (in de code dus andersom....;))
Code: 
'Uitzetten filtering:
    Sheets("ZOEKEN").Range("$A$4:$I$65000").AutoFilter Field:=2
    Sheets("ZOEKEN").Range("$A$4:$I$65000").AutoFilter Field:=9
'Inschakelen filtering:
'lege taken uit filteren
    ActiveSheet.Range("$A$4:$I$65000").AutoFilter Field:=2, Criteria1:="<>"
'uren 0 filteren
    ActiveSheet.Range("$A$4:$I$65000").AutoFilter Field:=9, Criteria1:=">0", Operator:=xlFilterValues
 
wampier zei:
Overigens zoekt de functie nu alle cellen af. Indien je alleen kolom "A" wil doorzoeken moet je de scope iets aanpassen
Klik om te vergroten...

De projectcode komt altijd alleen in de eerste kolom (A) voor maar hij moet wel de rij met informatie natuurlijk copieeren en plakken.

Bedoel je dat hij nu per rij (SearchOrder:=xlByRows) zoekt en dat dat ook anders kan, bv alleen in kolom A?
 
Je doorzoekt nu alle cellen in een tabblad (dat had je ook in je voorbeeld) Om eventuele onverwachte fouten te voorkomen kun je zoeken ook beperken tot alleen kolom "A". Gewoon dat je in het achterhoofd houdt dat als je zoekt op "B" of "1" je veel resultaten overal uit de sheet kan krijgen.

Toevoegen van de sheet is zeer eenvoudig. Je moet alleen even de kolom melden waar je het sheetnummer vermeld wil hebben dan kan ik zo de code geven.

Code: 
            Do
                Set plakplaats = Sheets("ZOEKEN").Range("a" & Sheets("ZOEKEN").Range("a65000").End(xlUp).Offset(1).Row)
                Sheets("ZOEKEN").Range(plakplaats, plakplaats.Offset(0, 10)).Value = Range(resultaat, resultaat.Offset(0, 10)).Value
                [COLOR="red"]Sheets("ZOEKEN").Range(plakplaats).offset(0,3).value = sheets(i).name[/COLOR]
                Set resultaat = .FindNext(resultaat)
            Loop While Not resultaat Is Nothing And resultaat.Address <> eerste.Address

De offset (0,3) moet aangepast worden naar de juiste kolom (nu "D")
 
Laatst bewerkt:
Het kan dat ik een typefout heb gemaakt. Ik doe dat vandaag uit het hoofd, daar ik geen excel voorhanden heb. Wat bedoel je ervoor? in de tekst of in een kolom ervoor (kolom A en de rest opschuiven?)
 
Ik heb geprobeerd om de offset op 9 te zetten aangezien de voorgaande regel nu op (0, 8) staat. Dan zou ik verwachten dat de waarde in kolom J zou komen te staan.
Dit werkte niet. Krijg geen waarde te zien alleen die foutmelding.

Code: 
Sub Zoeken()
'
' ZoekOp Macro
'
Dim zoek As String
Dim i As Integer
Dim resultaat As Range
Dim plakplaats As Range
Dim eerste As Range

    zoek = InputBox("Geef de te zoeken tekst op: ")
    If zoek = "" Then Exit Sub
    Application.ScreenUpdating = False

    Sheets("ZOEKEN").Range("$A$5:$J$65000").AutoFilter Field:=2
    Sheets("ZOEKEN").Range("$A$5:$J$65000").AutoFilter Field:=3
    Sheets("ZOEKEN").Range("$A$5:$J$65000").AutoFilter Field:=9

    Sheets("ZOEKEN").[a5:j65000].ClearContents

    For i = 1 To ActiveWorkbook.Worksheets.Count - 2
        With Sheets(i).Cells
        Set resultaat = .Find(What:=zoek, LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
        If Not resultaat Is Nothing Then
            Set eerste = resultaat
            Do
                Set plakplaats = Sheets("ZOEKEN").Range("a" & Sheets("ZOEKEN").Range("a65000").End(xlUp).Offset(1).Row)
                Sheets("ZOEKEN").Range(plakplaats, plakplaats.Offset(0, 8)).Value = Range(resultaat, resultaat.Offset(0, 8)).Value
                [COLOR="green"]'Sheets("ZOEKEN").Range(plakplaats).Offset(0, 9).Value = Sheets(i).Name[/COLOR]
                Set resultaat = .FindNext(resultaat)
            Loop While Not resultaat Is Nothing And resultaat.Address <> eerste.Address
        End If
        End With
    Next i
 
   If Sheets("ZOEKEN").[a5].Value = "" Then
    MsgBox ("Project niet gevonden")
    End If
 
    ActiveSheet.Range("C1:C650000").NumberFormat = "@"
    ActiveSheet.Range("$A$4:$J$65000").AutoFilter Field:=2, Criteria1:="<>"
    ActiveSheet.Range("$A$4:$J$65000").AutoFilter Field:=9, Criteria1:=">0", Operator:=xlFilterValues

    Application.ScreenUpdating = True

End Sub
De groene regel werkt niet en heb ik in de macro even uitgezet

Voor de rest in ieder geval al hartstikke bedankt want op het weeknummer na werkt het prima. Knap dat je dit gewoon uit je hoofd doe. Zonder de voorbeelden hier kom ik niet zo ver:o
 
Laatst bewerkt:
je kunt de groene regel vervangen met:

plakplaats.Offset(0, 11).Value = Sheets(i).Name
 
Dat werkt i.d.d. prima, dank je wel.

Als ik het goed heb kan ik door de volgende toevoeging alleen zoeken in kolom a:
Code: 
Set resultaat = [B].Range("a:a")[/B].Find(What:=zoek, LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
Ofwel
Code: 
Set resultaat = .Columns(1).Find(What:=zoek, LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
@Warme bakkertje:
Welk voordeel heeft Columns(1) t.o.v. Range("a:a")?
Stel dat ik bv in kolom 1 en 2 wil zoeken, moet ik dan het volgende intypen (1,2) ?
Met 1 enz wordt dus eigenlijk in VBA kolom A mee bedoelt?

Zullen vast rare/simpele vragen van mij tussen zitten maar ik leer VBA eigenlijk gewoon door de voorbeelden van andere.
Is er toevallig nog een aan te raden boek te koop voor VBA in excel 2007/2010?
 
Het is geen kwestie van voordeel maar van schrijfwijze. Om te antwoorden op je vraag
Code: 
Set resultaat = Union(.Columns(1), .Columns(2))

Beter nog is het juiste bereik te bepalen zodat er geen lege cellen moeten doorzocht worden, aangezien je nu beschikt over meer dan 1 milj. rijen

Boeken: John Walkenbach, Guy Hart-Davis
 
Laatst bewerkt:
In het definitieve bestand hoeft hij alleen te zoeken in kolom b van rij 10 t/m rij 90.
Mensen mogen geen rijen of kolommen toevoegen dus het project staat altijd in die rijen in kolom B.
Zou je dan het volgende instellen?
Code: 
Set resultaat = .Range("b10:b90").Find(What:=zoek, LookIn:=xlFormulas, Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
 
Dan wil ik wampier en Rudi ontzettend bedanken voor hun tijd en geduld.
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan