Print side | Luk vindue

Søg dato i kolonne

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=3634
Udskrevet den: 21.Apr.2025 kl. 05:53


Emne: Søg dato i kolonne
Besked fra: Ib Hansen
Emne: Søg dato i kolonne
Posteringsdato: 29.Sep.2018 kl. 12:04
Hej Forum.

Jeg vil helst undgå at /topic662.html" rel="nofollow - /topic662.html - uploade et ark, da det er stort og jeg ellers skal lave et test-ark med koden.

Men jeg forsøger at lave en kode, der kan søge og finde en dato.
Og herefter hoppe Offset til en celle ud for datoen.

Jeg har en kode der virker, men den søger hele det definerede område ("AE4:AE500"), efter datoen er fundet pga. - For Each p In k - Next p

Hvordan skal jeg definere at koden skal stoppe, når datoen er fundet og så hoppe til - Offset(0, -19) ?
Hvordan skal koden sættes op ?

Private Sub CommandButton1_Click()
    Unload Me
'----------'
' Søg dato '
'----------'
    Dim r As Date
    Dim k As Range
    Dim p As Range
       
    r = Sheets("ArkIndstil").Range("D1").Value
    
    Sheets("Forside").Select
    
    Set k = Range("AE4", Range("AE500").End(xlDown))
        For Each p In k
            If p.Value2 = r Then
                p.Offset(0, -19).Select
            End If
        Next p
End Sub

Ps. CommandButton1 er en Unload Me i en Userform, hvorfra datoen vælges vha. en DatoPicker.
Når Userformen lukkes, kører søge-koden.
Det virker, men søge-range skal udvides til måske ("AE10000").

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)


Svar:
Besked fra: Ib Hansen
Posteringsdato: 01.Okt.2018 kl. 09:35
Hej igen Forum.

LØST

Jeg fandt selv løsningen og den var selvfølgelig indlysende.
Jeg indsatte bare Exit Sub, efter datoen var fundet og stoppede koden fra at køre videre til Next p
Hvor dum kan man være Confused
Private Sub CommandButton1_Click()
    Unload Me
'----------'
' Søg dato '
'----------'
    Dim r As Date
    Dim k As Range
    Dim p As Range
       
    r = Sheets("ArkIndstil").Range("D1").Value
    
    Sheets("Forside").Select
    
    Set k = Range("AE4", Range("AE500").End(xlDown))
        For Each p In k
            If p.Value2 = r Then
                p.Offset(0, -19).Select
                Exit Sub
            End If
        Next p
End Sub

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Besked fra: EXCELGAARD
Posteringsdato: 01.Okt.2018 kl. 10:14
Et lille indspark...

'Exit Sub' kan nogle gange være uheldig, at benytte (dog ikke lige i dit tilfælde her), da man kan opsamle en del 'garbage collection' ved ikke, at afslutte 'For...Next' på 'korrekt' vis.

Her ville jeg nok benytte 'Exit For' i stedet.

Dette vil også give mulighed for at rydde op i dine objekt variabler i slutningen af koden: 
Set k = Nothing
Set p = Nothing
...hvilket jeg synes altid er en god ide Geek


-------------
Husk, at trykke på [Tak], hvis du kan lide et indlæg.
Husk, at trykke på [Accepteret Svar], hvis du kan bruge et løsningsforslag.

Besked fra: Ib Hansen
Posteringsdato: 01.Okt.2018 kl. 13:58
Hej Excelgaard.

jeg prøvede faktisk forskellige sammensætninger med "Nothing", da jeg samtidig ville have en MsgBox, hvis datoen ikke var i skemaet.
Men jeg gjorde det nok helt forkert, da det ikke kørte for mig.

En af de kombinationer jeg prøvede. 
Private Sub CommandButton2_Click()
    Unload Me
'----------'
' Søg dato '
'----------'
    Dim r As Date
    Dim k As Range
    Dim p As Range
       
    r = Sheets("ArkIndstil").Range("D1").Value
    
    Sheets("Forside").Select
    
    Set k = Range("AE4", Range("AE500").End(xlDown))
        For Each p In k
            If p.Value2 = r Is Nothing Then
                MsgBox "   Datoen findes ikke i skemaet."
                Exit Sub
            Else
                p.Offset(0, -19).Select
            End If
        Next p

End Sub

I stedet brugte jeg dette...
Private Sub CommandButton2_Click()
    Unload Me
'----------'
' Søg dato '
'----------'
    Dim r As Date
    Dim k As Range
    Dim p As Range
       
    r = Sheets("ArkIndstil").Range("D1").Value
    
    Sheets("Forside").Select
    
    On Error GoTo ud
    Set k = Range("AE4", Range("AE500").End(xlDown))
        For Each p In k
            If p.Value2 = r Then
                p.Offset(0, -19).Select
                Exit Sub
            End If
        Next p

ud: MsgBox "   Datoen findes ikke i skemaet.", vbInformation, ""

End Sub

Det er nok helt VBA'sk forkert sat op, men skidt, når bare koden virker LOL

Jeg vil dog prøve dit "Exit For" i stedet, men den har jeg aldrig hørt om før.
Jeg er jo, som du sikkert ved, ikke så VBA'sk kyndig Stern SmileDisapprove

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Besked fra: maxzpad
Posteringsdato: 04.Okt.2018 kl. 13:46
En anden fremgangsmåde kunne være at søge efter datoen således:

Dim varFindDatoRow as Variant

varFindDatoRow = Application.Match(CDbl(r), k, 0)

If Not Iserror(varFindDatoRow) Then

     Cells(varFindDatoRow, k.Column - 19).Select

Else

     Goto DatoIkkeFundet

End If

Besked fra: Ib Hansen
Posteringsdato: 04.Okt.2018 kl. 14:00
Tusind tak maxzpad Wink

Jeg kigger på det lidt senere.
Sidder i øjeblikket med nogle meget drilske koder i en ListBox, der nok skal bygges helt om DisapproveConfused

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Besked fra: Ib Hansen
Posteringsdato: 05.Okt.2018 kl. 14:55
Hej igen maxzpad

Koden virker perfekt og uden søgetid, hvis datoen ikke findes  Clap
Den er implementeret i arket og også gemt til senere brug Wink
Tusind tak.

Koden ser sådan ud
Sub CommandButton1_Click()
'--------------------------'
' Søg dato - Hop til celle '
'--------------------------'
    Dim varFindDatoRow As Variant
    
    r = Range("A1").Value '.............................Dato, der skal søges.
    Set k = Range("AE1", Range("AE500").End(xlDown)) '..Område, der søges i.
    
    varFindDatoRow = Application.Match(CDbl(r), k, 0)

    If Not IsError(varFindDatoRow) Then
        Cells(varFindDatoRow, k.Column - 19).Select '...Hop til celler efter søgning.
    Else
        MsgBox "   Datoen findes ikke"
    End If
End Sub
Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)

Besked fra: maxzpad
Posteringsdato: 05.Okt.2018 kl. 15:08
Hej Ib

Tak for feedback. Ja, du slipper for at køre et For-Each-loop, hvilket speeder makroen op.


Mvh Max

Besked fra: Ib Hansen
Posteringsdato: 05.Okt.2018 kl. 15:11
Hej Max

Perfekt og den kan bruges i andre ark også Clap

Mvh.
Ib


-------------
Excel 2010 Dk og 2019 Dk på samme computer.
Bruger dog stadig mest 2010..
Men sådan er der jo så majet :o)


Print side | Luk vindue