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

Naar gevraagde datum scrollen

Status
Niet open voor verdere reacties.

wieter

Terugkerende gebruiker
Lid geworden
26 jun 2009
Berichten
1.128
De datums in kolom A staan NIET in volgorde.!!!!
Met 3 ComboBoxen wordt naar een datum gezocht in kolom A.
Code:
Private Sub ComboBox3_Change()
Dim tmp As Variant, FirstAddress As Variant
    If ComboBox3.ListIndex > -1 Then
        tmp = DateSerial(ComboBox1.Value, ComboBox2.ListIndex + 1, ComboBox3.Value)
        With Worksheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
           [COLOR="#FF0000"] Set c = .Find(tmp, LookIn:=xlValues)[/COLOR]
            If Not c Is Nothing Then
                FirstAddress = c.Address
                Application.Goto ActiveSheet.Range(FirstAddress), Scroll:=True
            Else
                MsgBox "Datum niet gevonden"
            End If
        End With
        ComboBox1.ListIndex = -1
        ComboBox2.ListIndex = -1
        ComboBox3.Clear
    End If
End Sub
Als je nu naar 1/februari/2019 zoekt (maandwaarde =2)
Scrolt de rode code-regel naar de eerste maand die de waarde 2 bevat (dus ook de maand dec).
In dit geval naar 1/12/2019
Idem voor januari, de rode coderegel scrolt naar de eerste maand die de waarde 1 bevat (dus ook okt. , nov. en dec.).

Ik meen te weten dat voor [LookIn:=] alleen [xlComments; xlFormulas; en xlValues] mogelijk zijn.
Is hier een oplossing voor?
 

Bijlagen

Code:
Private Sub ComboBox3_Change()
Dim tmp As Variant, FirstAddress As Variant
    If ComboBox3.ListIndex > -1 Then
        tmp = DateSerial(ComboBox1.Value, ComboBox2.ListIndex + 1, ComboBox3.Value)
        With Worksheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
            Set c = .Find(tmp, LookIn:=xlValues, [COLOR="#FF0000"]Lookat:=xlWhole[/COLOR])
            If Not c Is Nothing Then
                FirstAddress = c.Address
                Application.Goto ActiveSheet.Range(FirstAddress), Scroll:=True
            Else
                MsgBox "Datum niet gevonden"
            End If
        End With
        ComboBox1.ListIndex = -1
        ComboBox2.ListIndex = -1
        ComboBox3.Clear
    End If
End Sub

Probeer dit eens, lijkt mij te werken.
 
Datums in Excel en zeker in combinatie met VBA blijven vervelende dingen en dan ook nog met Find. Het beste werkt het als je de datum omzet naar het datumgetal. Als alternatief met de datum als getal en zonder Find
Code:
Private Sub ComboBox3_Change()
  If ComboBox3.ListIndex > -1 Then
    c = Application.Match(CDbl(DateSerial(ComboBox1.Value, ComboBox2.ListIndex + 1, ComboBox3.Value)), Columns(1), 0)
    If IsNumeric(c) Then Application.Goto Cells(c, 1), True Else MsgBox "Datum niet gevonden"
    ComboBox1.ListIndex = -1
    ComboBox2.ListIndex = -1
    ComboBox3.ListIndex = -1
  End If
End Sub

Zo vind ik het logischer omdat je anders steeds alles weer moet invullen.
Code:
Private Sub ComboBox3_Change()
  If ComboBox3.ListIndex > -1 Then
    c = Application.Match(CDbl(DateSerial(ComboBox1.Value, ComboBox2.ListIndex + 1, ComboBox3.Value)), Columns(1), 0)
    If IsNumeric(c) Then
      Application.Goto Cells(c, 1), True
      ComboBox1.ListIndex = -1
      ComboBox2.ListIndex = -1
      ComboBox3.ListIndex = -1
     Else
      MsgBox "Datum niet gevonden"
    End If
  End If
End Sub
 
Laatst bewerkt:
Nuttige info!!!: Zoeken met Match i.p.v. Find. En CDbl-functie gebruiken.
Super bedankt VenA.
 
Geachte VenA, indien je tijd en zin hebt.
Code:
c = Application.Match(CDbl(DateSerial(ComboBox1.Value, ComboBox2.ListIndex + 1, ComboBox3.Value)), Columns(1), 0)
Duidt de criteriumwaarde (0) er op, dat Columns(1), niet in aflopende waarde moet staan?


De code achter ComboBox1 komt ook van jouw. (Alleen waarden, die voorkomen in Kolom1, opnemen in de List van CB1)
Stel nu dat er 5000 datums in kolom1 staan.
Gaat het dan lang duren voor de list van CB1 is opgemaakt?
Code:
Private Sub Workbook_Open()
'Alleen de jaren die voorkomen opnemen in de list van ComboBox1
On Error Resume Next
  ar = Sheets(1).Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)

  For j = 1 To UBound(ar)
    If InStr(c00, Right(ar(j, 1), 4)) = 0 Then c00 = c00 & "|" & Right(ar(j, 1), 4)
    'als het jaar ar(j,1) niet in de string c00 voorkomt (=0), dan toevoegen
  Next j
Blad1.ComboBox1.List = Split(Mid(c00, 2), "|")
Blad1.ComboBox2.List = Application.GetCustomListContents(4)
End Sub
Echt BEDANKT voor de tijd en moeite.
 
Laatst bewerkt:
Application.Match werkt het zelfde als de functie MATCH()/VERGELIJKEN() in een werkblad. De 0 zorgt ervoor dat er een exacte match moet zijn.

Of een bepaalde methode snel is, is afhankelijk van de rekenkracht van de computer. Een lusje van maar 5000x die volledig in het geheugen wordt afgehandeld zal niet lang duren. En anders werkt de rest ook niet lekker vlot.:d

In de bijlage een voorbeeldje met drie methoden. De eerste keer heb ik gedaan met 5000 rijen en de tweede keer met 15000 rijen. Stoei er maar eens mee dan zie je wel waar het omslagpunt ligt. De verschillen zijn significant of je er in de praktijk iets van merkt?;)
 

Bijlagen

Hartelijk bedankt,
Super, die test.
Mijn experimenteer laptop is een goedkoop dingetje, met nog een i3-processor.
Toch een zeer snel resultaat, met een realistisch aantal rijen. (Na verloop van tijd worden overbodige jaartallen toch verwijderd)
Ik wens je toch nog eens extra te bedanken voor de hulp, die je me steeds maar weer biedt!!!
 
De I3 is niet per definitie langzamer dan een I5 Of I7. Het hangt allemaal af van de specs en wat je verder in de laptop hebt zitten. Succes verder met jouw projectje en voor ORT vragen weet ik iig waar ik moet zijn.:d
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan