Søg
Avatar billede Don-K Novice
21. september 2019 - 11:44 Der er 14 kommentarer og
1 løsning

Hjælp til Søge funktion - Excel VBA

Halløj.
Jeg er ved at lave et ark, hvor jeg har forskellige typer af data; både tal og bogstaver/Ord.
Jeg vil gerne lave en søge funktion, i samme stil som "Søg/Erstat", men hvor brugeren ikke skal åbne denne, da arket skal være låst/beskyttet mod ændringer, og dermed skal der heller ikke være adgang til proceslinjen i toppen.

Mit ark har data i cellerne A2:I232. (på sigt vil arket blive udvidet)
Søgfeltet, som er tilladt for brugeren at skrive i, er i celle N1, hvor brugeren kan skrive søge teksten, og derefter klikke på knappen "Søg", hvorefter cellen(erne) highlightes med rammen, ligesom vi kender det fra "Find/Erstat" funktionen.
For hver gang der klikkes på "Søg" knappen, skal der springes til næste resultat. Er der ingen resultater, skal der vises en Infobox med teksten "Intet søgeresultat. Kontrollér din søgetekst og prøv igen."

Der skal være en knap, der følger med for hver gang der springes til et resultat, som gør det muligt for brugeren at komme retur til Celle N1.

Så! Jeg vil gerne, hvis der er en der kan hjælpe mig med koderne. Knappen "Søg" har jeg lavet :-)

Jeg har prøvet at indspille makroen til Find delen, samt set mange forskellige YT videoer, men jeg kan ikke få det til at fungere, og jeg har lidt til ingen kendskab med VBA/Makro når det kommer hertil.

Håber nogen vil hjælpe mig.
Avatar billede Jan Hansen Ekspert
21. september 2019 - 11:52 #1
Hej tror du griber det lidt forkert an.
Tror du har brug for en userform!
Avatar billede Jan Hansen Ekspert
21. september 2019 - 12:12 #2
Har lige lavet en lille demo der slet ikke er færdig udviklet men viser lidt af hvad der er muligt!!

https://www.dropbox.com/s/encjrzmkghk2pyw/S%C3%B8g.xlsm?dl=0
Avatar billede store-morten Ekspert
21. september 2019 - 14:59 #3
Lidt at lege med:
Sub FindAdresse()
Dim bytAns As Long

    Tekst = UCase(Range("N1"))
    Antal = 0
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
            Antal = Antal + 1
        End If
    Next c
   
        bytAns = MsgBox("Der er fundet: " & Antal & " celler?" & vbCrLf & _
        "Ønsker du at forsætte?", vbYesNo + vbQuestion, _
        "Bekræft forsættelse.")
            If bytAns = vbYes Then
                GoTo Søg
            Else
                Range("N1").Activate
                Exit Sub
            End If

Søg:
    Tekst = UCase(Range("N1"))
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
        c.Activate
       
            bytAns = MsgBox(Range("N1") & " er fundet i celle: " & c.Address & vbCrLf & _
            "Ønsker du at forsætte?", vbYesNo + vbQuestion, _
            "Bekræft forsættelse.")
                If bytAns = vbYes Then
                Else
                    Range("N1").Activate
                    Exit Sub
                End If
        End If
    Next c
End Sub
Avatar billede Don-K Novice
21. september 2019 - 18:13 #4
Jan Hansen: Tak for dit forslag, men jeg ønsker ikke at en boks skal komme frem.
Brugeren(e) skal have så få klik som muligt. :-)

store-morten: Det lugter lidt derhen ad. Men istedet for at få en boks op med hvor mange resultater der er fundet, samt hvilke celler det er, skal den blot springe videre til næste resultat ved klik på "Søg" knappen. Alternativ skal brugeren have mulighed for at trykke på Enter (Tasteturet) hvorefter der springes til næste resultat.

Den eneste boks der skal komme frem, er hvis der ikke er et resultat.
Avatar billede store-morten Ekspert
21. september 2019 - 18:16 #5
Og der skal ikke gøres yderligere?
Avatar billede store-morten Ekspert
21. september 2019 - 18:19 #6
Har siddet og leget lidt:
Sub FindAdresseRet()
Dim bytAns As Long
Dim RetBox As Variant

Tekst = UCase(Range("N1"))
    Antal = 0
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
            Antal = Antal + 1
        End If
    Next c
   
        bytAns = MsgBox("Der er fundet: " & Antal & " celler?" & vbCrLf & _
        "Ønsker du at forsætte?", vbYesNo + vbQuestion, _
        "Bekræft forsættelse.")
            If bytAns = vbYes Then
                GoTo Søg
            Else
                Range("N1").Activate
                Exit Sub
            End If

Søg:
Tekst = UCase(Range("N1"))
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
        c.Activate
       
            bytAns = MsgBox(Range("N1") & " er fundet i celle: " & c.Address & vbCrLf & _
            "Ønsker du at forsætte til næste celle?" & vbCrLf & _
            "Vil du rette, tryk på: Annuller", vbYesNoCancel + vbQuestion, _
            "Bekræft forsættelse.")
                If bytAns = vbYes Then
                Else
                If bytAns = vbCancel Then
             
                    RetBox = InputBox("Du har søgt efter: " & Range("N1") & vbCrLf & _
                        "Dette er fundet i celle: " & c.Address & vbCrLf & "Vil du rette dette?", _
                                        "Ret data", c, 1700, 1000)
                        If StrPtr(RetBox) = 0 Then
                        ElseIf RetBox = "" Then
                   
                        Else
                        ActiveCell = RetBox
                        End If
               
                Else
                    Range("N1").Activate
                    Exit Sub
                End If
                End If
        End If
    Next c
   

End Sub
Avatar billede Don-K Novice
21. september 2019 - 18:20 #7
Nej. Jeg havde lige glemt, da jeg skrev mit første indlæg, at jeg havde frosset øverste række, så brugeren kan se kolonne overskriften. Og da Celle N1 jo er i øverste række vil den jo fælge med efterhånden som der "zappes" videre.
Avatar billede Don-K Novice
21. september 2019 - 18:27 #8
svar til #6: Hold, hold, hold.... :-D
Det er langt, langt udover hvad der er nødvendigt :o)

Nedenunder er min Macro indspilning. Det er sådan set "bare" den jeg gerne vil have tilpasset, så den passer til mit ønske ud fra indlæg #4

------------------------------------------------------------
Sub Search()

    Range("N1").Select
    ActiveCell.FormulaR1C1 = "intego"
    Cells.Find(What:="intego", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate
    Cells.FindNext(After:=ActiveCell).Activate

End Sub
--------------------------------------------------------------------------------
Avatar billede store-morten Ekspert
21. september 2019 - 18:27 #9
Sub Søg()
Tekst = UCase(Range("N1"))
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
        c.Activate
       
            bytAns = MsgBox(Range("N1") & " er fundet i celle: " & c.Address, vbQuestion, _
            "Bekræft forsættelse.")
                If bytAns = vbYes Then
                Else
                    Range("N1").Activate
                End If
        End If
    Next c
End Sub
Avatar billede store-morten Ekspert
21. september 2019 - 18:47 #10
Eller:
Sub Søg()
Tekst = UCase(Range("N1"))
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
        c.Activate
          MsgBox c.Address
        End If
    Next c
End Sub
Avatar billede store-morten Ekspert
21. september 2019 - 18:54 #11
Og med stop hvis N1 er tom:
Sub Søg()
If Range("N1") = "" Then Exit Sub
Tekst = UCase(Range("N1"))
    For Each c In ActiveSheet.Range("A2").CurrentRegion
        If InStr(1, UCase(c.Value), Tekst) > 0 Then
        c.Activate
          MsgBox c.Address
        End If
    Next c
Range("N1").Activate
End Sub
Avatar billede Jan Hansen Ekspert
21. september 2019 - 18:55 #12
Mon det er denne du søger?

Sub Søg()
        Cells.Find(What:=Range("N1").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
End Sub
Avatar billede Jan Hansen Ekspert
21. september 2019 - 19:03 #13
Med Msgbox for intet fundet

Sub Søg()
        Cells.Find(What:=Range("N1").Value, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
        If ActiveCell.Address = "$N$1" Then
            MsgBox "'" & Range("N1").Value & "'" & " er ikke fundet!"
        End If
End Sub
Avatar billede Don-K Novice
21. september 2019 - 19:19 #14
Tak Jan. Der skulle lige fixes lidt, men det er en holdbar løsning :-)
Avatar billede Jan Hansen Ekspert
21. september 2019 - 19:51 #15
velbekomme, Alt skal tilpasses.
Avatar billede Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.

Loading billede Opret Preview
Kategori
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Stempel ur start og stop Af lurup i Excel 1 23/03/202613:24 23/03/202621:06
Hvordan bruges indeks & sammenlign når der skal søges over flere kolonner? Af Laugesen1 i Excel 4 08/03/202611:56 08/03/202613:57
Tips til at mestre Excel hurtigt Af MonikaG32 i Excel 4 04/03/202617:11 06/03/202609:37
Båndet i Excel online har ændret størrelse Af Monique i Excel 3 19/02/202614:23 20/02/202608:26
Fjern tekst efter mellemrum Af ABE15 i Excel 2 18/02/202620:41 19/02/202611:30
Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I dag 12:08 Problemer med replay af købte kursusvideoer Af annam i Browsere
I går 11:18 DENVER DVB-tMPEG-4 HD TUNER Af ole falsted i Fjernsyn & projektorer
I går 10:03 Låst D-drev skal genoprettes Af barth i Andet software
27/0313:51 Vest Tysk film - fra 1955 ? - Søges - Navn på film og forfatter har jeg glemt Af Ikke-ekspert i Fri debat
27/0305:41 Messenger kræver kode. Af Per i PC
White papers
Flere white papers »