21. september 2019 - 11:44Der 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.
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
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.
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
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.
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
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
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
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
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.