Søge-Makro i Excel

Hvorfor ikke bruge den funktion der allerede er indbygget i Excel : Edit-> Find (eller Rediger-Søg eller noget i den stil)

Ahh - Doh! Den kan kun finde i det aktive ark...

jeg lavede engang denne makro, den skal have sit eget ark ved navn Forside.

den skriver hyperlink til alle celler, hvor det søgte er fundet.

du må selv vælge om den søger på hele celler, eller dele af celler.

Sub FindOrd()
Dim Fundet(100) As String
I = 1
On Error GoTo Slut
    søg = InputBox("Skriv søgestrengen på hvad der skal Findes", "Find medicinske præparater")
    For Each ws In Worksheets
If ws.Name <> "Forside" Then ' skift selv navnet på forsiden
      Sheets(ws.Name).Select
      Columns("A:Z").Select 'området den søger på ret det selv til
     
      '************** find hele ord ****************
        Selection.Find(What:=søg, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
        .Activate
       
          '************** find dele af ord ****************
      ' Selection.Find(What:=søg, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
       
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ws.Name & "!" & ActiveCell.Address
          If I > 1 Then
        For T = 1 To I - 1
          If Fundet(I) = Fundet(T) Then
          I = I - 1
        End If
        Next
      End If
      I = I + 1
    Do
      Cells.FindNext(After:=ActiveCell).Activate
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ws.Name & "!" & ActiveCell.Address
      If I > 1 Then
        For T = 1 To I - 1
          If Fundet(I) = Fundet(T) Then
                GoTo Videre
          End If
        Next
      End If
      I = I + 1
  Loop
End If
Videre:
Next
Slut:
  Sheets("Forside").Select
  Range("a2:a101").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents
    Range("a1") = søg
    Range("a2").Select
  For T = 1 To I - 1
    Worksheets("forside").Range("a2:a101").Cells(T, 1).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Fundet(T)
    ActiveCell.FormulaR1C1 = Fundet(T) ' skriver hyperlink på alle fundne steder
      Next
End Sub

Det er jo altid nemt at komme med tilføjelser til noget andre har lavet :o)

Hvorfor lave Fundet() som et statisk array med 100 poster - hvorfor ikke dynamisk (med Redim)?

Ellers lækker kode, den napper jeg lige til engang jeg får brug for en sådan funktion :o)

den var lavet til en bestemt mappe, såå det var hurtigere lige at sætte et maks på 100.

Ok - det er bare mig der er flueknepper :o)

Martin --> forresten hvor vil du sætte redim ind.

du ved jo ikke antallet før den er færdig.
Vil du redimme hver gang den fandt en mere ?

Nemlig!

Jeg ´bruger altis dynamiske arrays når jeg ikke kender arrayets endelige størrelse på forhånd - jeg synes det er "spild" med 100 pladser hvis der fx. kun bliver brugt 5 - eller hvad hvis der bliver fundet 101 ord? ;o)

Men jeg bruger redim Preserve - uden "preserve" overskriver den det gamle array :o)

Men som sagt - flueknepperi

ok jeg giver dig lige en udbygget makro, den henter hele rækken med det fundne over i arket Forside,

Sub FindOrd()
Dim Fundet(300, 5) As String, Sted(300) As String, Søg As Variant, I As Integer, T As Integer
Dim R As Integer, Side(300) As String
I = 1
On Error Resume Next
Range("D1").Select
  Sheets("Forside").AutoFilterMode = False
  Sheets("Forside").Select
  Range("B2:I301").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents
    Range("a2").Select
    Søg = InputBox("Skriv søgestrengen på hvad der skal Findes")
Application.ScreenUpdating = False
    For Each ws In Worksheets
If ws.Name <> "Forside" Then ' skift selv navnet på forsiden
      Sheets(ws.Name).Select
      Range("A1:H500").Select 'området den søger på ret det selv til
      Selection.Find(What:=Søg, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
        If Err.Number = 91 Then
          Err.Clear
        GoTo Videre
        End If
        a = ActiveCell.Row
        If a = 1 Then GoTo Videre
        b = ActiveCell.Column
        Cells(a, b).Activate
        Side(I) = ws.Name
        Sted(I) = "'" & ws.Name & "'!" & ActiveCell.Address
        For T = 1 To 5
        Fundet(I, T) = Sheets(ws.Name).Cells(a, T).Value
        Next
          If I > 1 Then
        For T = 1 To I - 1
          If Sted(I) = Sted(T) Then
          GoTo Videre
        End If
        Next
      End If
      I = I + 1
    Do
      Cells.FindNext(After:=ActiveCell).Activate
        If Err.Number = 91 Then
        Err.Clear
        GoTo Videre
        End If
        a = ActiveCell.Row
          If a = 1 Then GoTo Videre
        b = ActiveCell.Column
        Cells(a, b).Activate
        Side(I) = ws.Name
        Sted(I) = "'" & ws.Name & "'!" & ActiveCell.Address
        For T = 1 To 5
        Fundet(I, T) = Sheets(ws.Name).Cells(a, T).Value
        Next
      If I > 1 Then
        For T = 1 To I - 1
        If Sted(I) = Sted(T) Then
                GoTo Videre
          End If
        Next
      End If
     
      I = I + 1
  Loop
End If
Videre:
Next
Slut:
  Sheets("Forside").Select
  Application.ScreenUpdating = True
  For T = 1 To I - 1
    Worksheets("forside").Range("B2:F101").Cells(T, 1).Select
    For R = 1 To 5
      ActiveCell.Offset(0, R) = Fundet(T, R)
    Next
      ActiveCell.Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Sted(T)
        ActiveCell.FormulaR1C1 = Side(T) ' skriver hyperlink på alle fundne steder
      Next
    Range("D7").Select
      Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
          Range("C2").Select
    If I = 1 Then
      MsgBox " ingen fundet"
      End If
    Range("D1").Select
    Selection.AutoFilter
End Sub

jeg takker mange gange kabbak... men jeg skal bruge en med "find næste" funktion da det ikke er holdbart i denne løsning at lave en forside til output'et..... men derimod må den gerne hoppe frem til ordet og vise muligheden for at finde den næste i rækken

Du har jo koden nu - kan du ikke selv smide en "find næste" funktion ind?

Martin.
Problemet er det at jeg ikke ved hvordan jeg får den til at stoppe ved hvert søgeresultat.. ellers var det simpelt nok ja. .:)

Desuden er jeg ikke så hård i macro programmering.. og ved ikek helt hvad der skal slettes for at det med forside output'et ikke bliver udført.. desuden sletter den en pæn del som jeg også skal have forhindret....

jeg må indrømme at jeg ikke selv har kikket koden 100% igennem. Mon ikke kabbak tager over? Ellers er det et spørgsmål om at få læst koden linie for linie og sørge for at forstå hver linie - når man kan det er det som regel ingen sag at omskrive. Men sætter min lid til kabbak :o)

Hehe... I know.. har sat og kigget på det og er kommet frem til at den nedenstående kode er noget jeg kan bruge..... så skal jeg bare have fundet hvor den tjekker på værdierne af cellerne og sat en ting ind som sætter fokus hvis den finder noget den kan bruge... og smider en slags messagebox op som stopper programmet eller lader det kører vider alt efter hvad brugeren ønsker

Sub FindOrd()
Dim Fundet(300, 5) As String, Sted(300) As String, Søg As Variant, I As Integer, T As Integer
Dim R As Integer, Side(300) As String
I = 1
On Error Resume Next
  Sheets("LP 1").Select
    Range("a2").Select
    Søg = InputBox("Skriv søgestrengen på hvad der skal Findes")
Application.ScreenUpdating = False
    For Each ws In Worksheets
If ws.Name <> "Forside" Then ' skift selv navnet på forsiden
      Sheets(ws.Name).Select
      Range("A1:H500").Select 'området den søger på ret det selv til
      Selection.Find(What:=Søg, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
        If Err.Number = 91 Then
          Err.Clear
        GoTo Videre
        End If
        a = ActiveCell.Row
        If a = 1 Then GoTo Videre
        b = ActiveCell.Column
        Cells(a, b).Activate
        Side(I) = ws.Name
        Sted(I) = "'" & ws.Name & "'!" & ActiveCell.Address
        For T = 1 To 5
        Fundet(I, T) = Sheets(ws.Name).Cells(a, T).Value
        Next
          If I > 1 Then
        For T = 1 To I - 1
          If Sted(I) = Sted(T) Then
          GoTo Videre
        End If
        Next
      End If
      I = I + 1
    Do
      Cells.FindNext(After:=ActiveCell).Activate
        If Err.Number = 91 Then
        Err.Clear
        GoTo Videre
        End If
        a = ActiveCell.Row
          If a = 1 Then GoTo Videre
        b = ActiveCell.Column
        Cells(a, b).Activate
        Side(I) = ws.Name
        Sted(I) = "'" & ws.Name & "'!" & ActiveCell.Address
        For T = 1 To 5
        Fundet(I, T) = Sheets(ws.Name).Cells(a, T).Value
        Next
      If I > 1 Then
        For T = 1 To I - 1
        If Sted(I) = Sted(T) Then
                GoTo Videre
          End If
        Next
      End If
     
      I = I + 1
  Loop
End If
Videre:
Next
End Sub

Desuden tror jeg at jeg skal bruge InStr(din_string, dit_ord) for at få den korrekte søgning ud af det... men det er jo relativt simpelt at ordne.

prøv denne

Sub FindOrd()
Dim Fundet(100) As String
I = 1
On Error GoTo Slut
    søg = InputBox("Skriv søgestrengen på hvad der skal Findes", "søgetekst")
    For Each ws In Worksheets
      Sheets(ws.Name).Select
       
      '************** find hele ord ****************
      '    Cells.Find(What:=søg, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
        .Activate
       
          '************** find dele af ord ****************
        Cells.Find(What:=søg, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
       
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ws.Name & "!" & ActiveCell.Address
          If I > 1 Then
        For T = 1 To I - 1
          If Fundet(I) = Fundet(T) Then
          I = I - 1
        End If
        Next
      End If
        Svar = InputBox("ret værdi", "fundet " & søg & " her 1 " & Fundet(I))
        If Svar <> "" Then
        Cells(A, b) = Svar
    End If
      I = I + 1
    Do
      Cells.FindNext(After:=ActiveCell).Activate
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ws.Name & "!" & ActiveCell.Address
      If I > 1 Then
        For T = 1 To I - 1
          If Fundet(I) = Fundet(T) Then
                GoTo Videre
          End If
        Next
      End If
      Svar = InputBox("ret værdi", "fundet ('" & søg & "') her 2 " & Fundet(I))
      If Svar <> "" Then
        Cells(A, b) = Svar
    End If
      I = I + 1
  Loop
Videre:
Next
Exit Sub
Slut:
If Err.Number = 91 Then
Err.Clear
Resume Videre
End If
End Sub

Mange takker Kabbak.... nu er der kun meget få rettelser tilbage af koden som jeg selv vil prøve kræfter med... men så snart jeg er færdig med dem.. (15minutter forhåbentligt) så er pointene dine...

Mange tak for det... og også tak for ikke at gøre det for let for mig... så lærer jeg jo ikke en skid... men er jo af og til lidt doven.. :)

Den endelige kode er ikke meget forskellige fra Kabbak's sidste svar men hvis nogen kan bruge det til noget er den her under.

Sub FindOrd()
Dim Fundet(100) As String
I = 1
On Error GoTo Slut
    Søg = InputBox("Skriv ordet der ønskes fundet", "Søg")
    If Søg = "" Then
        End
    End If
    For Each ws In Worksheets
      Sheets(ws.Name).Select
       
      '************** find hele ord ****************
      '    Cells.Find(What:=søg, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) _
        .Activate
       
          '************** find dele af ord ****************
        Cells.Find(What:=Søg, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
       
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ws.Name & "!" & ActiveCell.Address
          If I > 1 Then
        For T = 1 To I - 1
          If Fundet(I) = Fundet(T) Then
          I = I - 1
        End If
        Next
      End If
        Valg = MsgBox("Ønsker De at søge videre?", vbYesNo, "Fundet værdi")
        If Valg = vbNo Then
            End
        End If
      I = I + 1
    Do
      Cells.FindNext(After:=ActiveCell).Activate
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ws.Name & "!" & ActiveCell.Address
      If I > 1 Then
        For T = 1 To I - 1
          If Fundet(I) = Fundet(T) Then
                GoTo Videre
          End If
        Next
      End If
      Svar = InputBox("ret værdi", "fundet ('" & Søg & "') her 2 " & Fundet(I))
      If Svar <> "" Then
        Cells(A, b) = Svar
    End If
      I = I + 1
  Loop
Videre:
Next
Exit Sub
Slut:
If Err.Number = 91 Then
Err.Clear
Resume Videre
End If
End Sub