Tabbladen doorzoeken op datum

[Rene046]

Hoi,

Wou vragen of het op een of andere manier mogelijk is om een aantal tab bladen (6 stuks)
te doorzoeken op bepaalde datums die meer dan 1 jaar oud zijn.

en deze dan in een nieuwe tab te kopieeren met alle gegeven die op die rij staan
zodat ik een lijst krijg die ik kan uitprinten met alle oude producten.


dit lijk me wel heel erg lastig.

vooral voor mij omdat ik vandaag voor het eerst een macro gemaakt heb.
Ik weet eigenlijk niet hoe ik dit moet of kan aanpakken.

dus iedere tip is welkom.

groetjes Rene

 

[huijb]

Eerst even dit lezen a.u.b. http://www.helpmij.nl/forum/showthread.php?t=278887

 

[Rene046]

Eerst even dit lezen a.u.b. http://www.helpmij.nl/forum/showthread.php?t=278887

hoi Michel.

dank je.

je bedoel dat het onduidelijk is met hulp gevraagt.

maar ik weet niet hoe ik dit moet beschijven ? gezocht hulp met datum filter
of zo.

sorry .

 

[huijb]

hoi Michel.

dank je.

je bedoel dat het onduidelijk is met hulp gevraagt.

maar ik weet niet hoe ik dit moet beschijven ? gezocht hulp met datum filter
of zo.

sorry .

Dat is al een veel betere titel, vind jezelf ook niet.

 

[Wigi]

Lees hier voor uitgebreide eerdere code van mezelf.

 

[Rene046]

Hoi Wigi,

Dus je meent het is mogelijk alle 6 tab bladen af te zoeken naar de TESTDATUM, en de datums die ouder zijn dan 1 jaar met de geheele rij gegevens in een nieuwe tab te plaatsen?

en dit via 1 macro die als ik het xls bestand open deze lijst maakt

ik ben nieuw op gebied macro's

moet ik dan zoiets maken als

Sub zoekmaar()
'
Dim zoeknaar As String
zoeknaar = vandaag()-365

Cells.Find(What:=zoeknaar, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
MsgBox ("Zoekstring " & zoeknaar & " gevonden op " & ActiveCell.Address)
End Sub

 

[huijb]

@Rene046 wel even erbij blijven he, ik heb dezelfde reactie verwijderd uit een andere topic.

 

[Wigi]

Ja, dat is mogelijk.

Ik zou zeggen, ga er maar eens rustig wat mee stoeien, je hebt al de ribbenkast van de code. De schoonheidsprijs hoeft het niet te winnen. Wel eerst een kopietje van het bestand nemen

 

[Rene046]

@Rene046 wel even erbij blijven he, ik heb dezelfde reactie verwijderd uit een andere topic.

Ja Sorry ...


dacht dat ik hem zelf verwijderd had..

 

[Wigi]

En gebruik wel mijn eerdere code als uitgangspunt.

De code van Jan heeft geen lus doorheen de tabbladen.

Wigi

 

[Rene046]

Wigi

de code van jou krijg ik niet aan de praat, zal wel mijn fout zijn.

hij wordt niet gezien als macro. zie nu dat hij ook niet als normaal met sub.. begint maar met Function zoekmaar(s As String) As String

dus ik denk dat ik niet weet hoe en waar ik dit moet zetten.

grtz Rene

 

[Wigi]

Plak de code in een module in VBA.

Je kan die functie dan rechtstreeks in een cel in Excel gebruiken.

Bv.

=zoekmaar("rené")

Wat ook kan is die functie "aanspreken" in een gewone sub. Zoiets als

MsgBox zoekmaar("rené")

Wigi

 

[Rene046]

Ik denk dat ik daar niet verder mee kom.

als ik namelijk =zoekmaar("26-10-07") in geef vind hij niks
en als ik fv in geef krijg ik alleen =CAT01!R2 dus de allereerste die hij vind.

wat ik bedoel is iets (liefst een macro) die alle tab bladen doorzoekt cat01 tot cat14
en daar alle datums die ouder zijn dan 1 jaar herkent, en dan van die regel alle gegevens
pakt en me die op een lege tab plaatst.
zodat ik een onderhouds lijst heb die uitgeprint kan worden.
zodat deze gekeurd kunnen worden.

dacht al dat dit niet al te makelijk zal gaan...
het is dat een collega van mij al al die producten een nummer heeft gegeven anders was het gewoon 1 lijst geweest met normale nummers.

 

[Wigi]

Het is nu eenmaal zo dat hetgeen jij wil bereik veel beter in een gewone procedure kan, en niet met een functie.

In code van de functie zorgt de

Exit Function

ervoor dat dat stopt. (Niet dat die functie meerdere cellen zou vinden, maar goed).

Dus, eerste wat je zal moeten doen is de functie ombouwen tot een Sub.

En vervolgens zal je ook code moeten schrijven voor het kopiëren zelf. Nu wordt een celverwijzing aangemaakt, jij zal andere code nodig hebben.

Er staat je dus nog één en ander te wachten

En met datums in zoekfuncties heeft Excel wel wat last, dus dat is normaal.

Wigi

 

[Rene046]

Ach jamer dat het zo ingewikkeld moet zijn om het makelijker te maken.

zal nog een rond neuzen op internet of iemand als zoiets eens gemaakt heeft

anders moet ik zoek naar een programma dat dit kan, helaas access hebben ze op het werk niet dus kan ik die niet gebruiken.

dacht een tab sorteren op datum
dan alles kopieren wat meer dan 365 dagen oud is en in nieuwe leeg tap zetten.
en dat voor alle 6 die tabs.

de control-f functie komt erg kort in de buurt , geeft mooie lijst maar helaas neemt de marco recorder hier dit niet op wat hij allemaal doet.
zoeken binnen werkmap, zoekrichting kolom, zoeken in waarden, zoeken naar 26-10-07

geef de compleete lijst met blad en cel verwijzingen .

maar goed als je iets weet.. laat het me weten.

grtz Rene

 

[Withaar]

Gaat het alleen om de kolom Testdatum, of moet er ook met Volgende test rekening worden gehouden?

N.b. ik zou eerst alle data uit de 6 tabbladen kopieeren naar een leeg tabblad en dan sorteren en alles jonger dan een jaar weg (laten) gooien.
Dat kan je met de hand vrij snel doen (5 min...) of door een macro laten doen.
Dergelijke vragen/oplossingen zijn volgens mij ook wel eerder voorbij gekomen op het forum.

 

[Rene046]

Hoi ben weer flink stuk verder

had namelijk dit gebruikt

y = 1
cy = 2
Sheets("testCat01").Select
    For Each d In Worksheets("CAT01").Range("H2", "H2000").Cells
        'MsgBox "waarde=" + Str(c.Value)
        waarde = DateDiff("d", d.Value, Now)
        If waarde >= 365 Then
        y = y + 1
        'MsgBox "Kabel controle imminent!"
         Sheets("testCat01").Cells(y, 1).Value = Worksheets("cat01").Cells(cy, 1).Value
         Sheets("testCat01").Cells(y, 2).Value = Worksheets("cat01").Cells(cy, 2).Value
         Sheets("testCat01").Cells(y, 3).Value = Worksheets("cat01").Cells(cy, 3).Value
         Sheets("testCat01").Cells(y, 4).Value = Worksheets("cat01").Cells(cy, 4).Value
         Sheets("testCat01").Cells(y, 5).Value = Worksheets("cat01").Cells(cy, 5).Value
         Sheets("testCat01").Cells(y, 6).Value = Worksheets("cat01").Cells(cy, 6).Value
         Sheets("testCat01").Cells(y, 7).Value = Worksheets("cat01").Cells(cy, 7).Value
         Sheets("testCat01").Cells(y, 8).Value = Worksheets("cat01").Cells(cy, 8).Value
        End If
        cy = cy + 1
    Next

maar goed nu gaat hij ervan uit dat hij vanuit de kolom testdatum (H2) de nieuwe datum is
en dus hier kijkt of het verschil grote is dan 365 dagen

wat ik nu wil berijken is dat ik naast de kolom testdatum een kolom periodiek(H3) zet
waar ik dus de aantal maanden wat tussen iedere controlle in kan zitten in plaats.

ik moet dus de testdatum nemen hier b.v. 13 maanden bijtellen

hoe pak ik dit aan.

ik weet dat ik nu waarde = DateDiff("d", d.Value, Now) veranderen moet naar
waarde = DateDiff("m", d.Value, Now)
maar laat ik dit If waarde >= 365 Then nu zoeken naar de waarde in de cel ernaast waar men
het aantal maanden invult

 

[Rene046]

Ben weer stuk verder maar heb nog een probleempje.

' **********************
' Datumtest voor CAT01
' **********************
y = 1
cy = 2
Sheets("testCat01").Select
     For Each d In Worksheets("CAT01").Range("C2:C1000").Cells
     
        
        'MsgBox "waarde=" + Str(c.Value)
        waarde = DateDiff("m", d.Value, Now)
        MeetAfstand = Worksheets("cat01").Cells(cy, 4).Value
        If waarde >= MeetAfstand Then
        y = y + 1
        'MsgBox "Kabel controle imminent!"
         Sheets("testCat01").Cells(y, 1).Value = Worksheets("cat01").Cells(cy, 1).Value
         Sheets("testCat01").Cells(y, 2).Value = Worksheets("cat01").Cells(cy, 2).Value
         Sheets("testCat01").Cells(y, 3).Value = Worksheets("cat01").Cells(cy, 3).Value
         Sheets("testCat01").Cells(y, 4).Value = Worksheets("cat01").Cells(cy, 4).Value
         Sheets("testCat01").Cells(y, 5).Value = Worksheets("cat01").Cells(cy, 5).Value
         Sheets("testCat01").Cells(y, 6).Value = Worksheets("cat01").Cells(cy, 6).Value
         Sheets("testCat01").Cells(y, 7).Value = Worksheets("cat01").Cells(cy, 7).Value
         Sheets("testCat01").Cells(y, 8).Value = Worksheets("cat01").Cells(cy, 8).Value
         Sheets("testCat01").Cells(y, 9).Value = Worksheets("cat01").Cells(cy, 9).Value
         Sheets("testCat01").Cells(y, 10).Value = Worksheets("cat01").Cells(cy, 10).Value
        End If
        cy = cy + 1
    Next

zoals je ziet loopt het zover nu, aleen weet ik niet hoe ik de regel:

For Each d In Worksheets("CAT01").Range("C2:C1000").Cells

inplaats van cell C2 tot cell C1000 gewoon laat zoeken tot de laast ingevulde regel.
omdat hij zo 6 lijsten doorzoekt kan ik weer tijd sparen als hij dit zelf ziet.


groetjes Rene.

 

[Wigi]

Dim m As Integer

' **********************
' Datumtest voor CAT01
' **********************
    y = 1
    cy = 2
    
    Sheets("testCat01").Select

    For Each d In Sheets("CAT01").Range("C2:C" & Sheets("CAT01").Range("C" & Rows.Count).End(xlUp).Row)

        'MsgBox "waarde=" + Str(c.Value)
        waarde = DateDiff("m", d.Value, Now)
        MeetAfstand = Worksheets("cat01").Cells(cy, 4).Value
        If waarde >= MeetAfstand Then
        
            y = y + 1
            
            'MsgBox "Kabel controle imminent!"
            For m = 1 To 10
                Sheets("testCat01").Cells(y, m).Value = Worksheets("cat01").Cells(cy, m).Value
            Next
            
        End If
        cy = cy + 1
    Next

Wigi

 

[Rene046]

Wigi

je ben snel en Super.


werkt als boter.

Het werkt eigenlijk als zo goed als..
Heb aleen nog paar vraagjes die los staan van het thema datum.

maar weet niet of ik die hier dan nog mag vragen.

bedankt alvast.