Søg i Regneark vha VBA

Her er en søgemakro
Sæt den ind i et modul
Ret selv forside navn (flere steder),og det område som den skal søge på

Den indsætter hyperlink på forsidearket I kolonne j

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:E").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
        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("F2:F101").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents
    Range("a2").Select
  For T = 1 To I - 1
    Worksheets("forside").Range("F2:F101").Cells(T, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Fundet(T)
    ActiveCell.FormulaR1C1 = Fundet(T) ' skriver hyperlink på alle fundne steder
      Next
End Sub

Hej kabbak
Det ser fint ud men desværre fremkommer compilation error ved: "Søg ="

Ups - den skulle selvfølgelig bare defineres. Jeg prøver den lige.

Den virker tilsyneladende godt nok DOG fungerer hyperlinkene ikke - hvad kan problemet være?

prøv om du selv kan lave et hyperlink til en celle på et andet ark.

eller tjek dine tilføjelses programmer i funktioner indstillinger

hvilken exel version har du ?.

Når jeg forsøger at aktivere hyperlinket skriver den:  "referencen er ugyldig".
Excel 2002

prøv at lave en selv, mens du optager en makro.

sammenlign så koden, med den jeg har lavet, der er måske en forskel, jeg har kun excel 2000.

Det mystiske er at jeg kan lave referencerne fuldstændig ens (optaget med makro og redigeret) og alligevel skriver den ovenstående.

virker dem du selv laver ?

Næsten - den bringer mig til korrekte side men markerer kun celle A1 uanset hvad jeg har skrevet.

Hvis du højreklikker på hyperlink og vælger rediger, hvad står der så i cellereferencen

A1 både i den jeg har lavet og den "ugyldige cellereference"

peger den også på det rigtige ark ?

Aha - den referencen "den ugyldige" har lavet er til forsiden og ikke hvor den har fundet den (selvom det står i text'en)

Har du rettet hvor der Ws.name, det må du ikke

Det eneste jeg har rettet er for at få slettet den foregående søgning - på følgende måde:

Slut:
  Sheets("Forside").Select
  Range("J2:J101").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents
    Range("a2").Select
  For T = 1 To I - 1
    Worksheets("forside").Range("F2:F101").Cells(T, 5).Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=Fundet(T)
    ActiveCell.FormulaR1C1 = Fundet(T) ' skriver hyperlink på alle fundne steder
      Next
End Sub

Range("J2:J101").Select
  Worksheets("forside").Range("F2:F101").Cells(T, 5).Select

  disse skal pege på samme område, men det har ikke noget med fejlen at gøre,

Men hvis de gør det - sletter den IKKE foregående søgning - listen bliver længere og længere

ret til

Worksheets("forside").Range("F2:F101").Cells(T,1).Select

så skriver den i F kolonnen og så skal den anden også være
Range("F2:F101").Select

en fejl fra min side

Hyperlinkene virker fint ved mig.

Hedder dit hovedark også Forside ?.

Ja forsiden hedder forside (oprettet til samme funktion - faktisk et tomt ark med en kommandoknap til at udføre makroen med)

jeg kan desværre ikke hjælpe med hyperlinkene, da de virker hos mig, men en anden løsning er at vise værdien af de celler den finder.

Hvis du er intresseret.

Ja tak meget!

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:E").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
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Fundet(I) = ActiveCell.Value
          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) = ActiveCell.Value
      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("F2:F101").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents
    Range("a2").Select
  For T = 1 To I - 1
    Worksheets("forside").Range("F2:F101").Cells(T, 1).Select
      ActiveCell = Fundet(T)
      Next
End Sub

den skriver nu hvad der er i cellen, med det fundne ord i

Den skriver ikke alle cellerne med de fundne ord - er der en nem forklaring på det?

Columns("A:E").Select 'området den søger på ret det selv til

i øjeblikket søger den fra kolonne A til E, hvis det ikke er nok så ret E til et andet bogstav.

Det er nu ikke det der er problemet: Den viser faktisk ikke alle værdier i det område der allerede er selekteret.

ok jeg tror jeg ved hvad der er galt, før tjekkede jeg på celleadressen, nu kun på indholdet, hvis det er ens vises det kun 1 gang.

OK - kan det løses?

Sub FindOrd()
Dim Fundet(100) As String, Sted(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:H").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
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Sted(i) = ws.Name & "!" & ActiveCell.Address
        Fundet(i) = ActiveCell.Value
          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
        A = ActiveCell.Row
        b = ActiveCell.Column
        Cells(A, b).Activate
        Sted(i) = ws.Name & "!" & ActiveCell.Address
        Fundet(i) = ActiveCell.Value
      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
  Range("F2:G101").Select            ' sletter alle data i området til hyperlink
    Selection.ClearContents
    Range("a2").Select
  For t = 1 To i - 1
    Worksheets("forside").Range("F2:F101").Cells(t, 1).Select
      ActiveCell.Offset(0, 1) = Fundet(t)
      ActiveCell = Sted(t)
      Next
End Sub

prøv den

Den fejler ved:

      Selection.Find(What:=Søg, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate

var det ikke det der var galt i starten


du skrev

Ups - den skulle selvfølgelig bare defineres. Jeg prøver den lige.

Nå jeg har måske alligevel lavet noget galt: Jeg har skrevet
Dim Søg as String - hvorefter den ophørte med at fejle.

det kan være at Excel 2002 er mere følsom over for dim af variabler end Excel 2000

Måske - men det hjalp nu ikke i det sidste eksempel hvor søg er defineret :0(

prøv med

dim Søg As Variant

Øv samme problem

her er alle dimmet

Dim Fundet(100) As String, Sted(100) As String, Søg As Variant, I As Integer, T As Integer

Samme problem :0((

Du kan prøve at sende en kopi af arket, men jeg ved ikke om jeg kan køre det med min excel.

Kabbak@tiscali.dk

Jeg kunne ikke sende til dig ( blev afvist af serveren) så her er koden.

fejlen kom når den ikke fandt det søgte på en side.

du får alle oplysninger nu

Sub FindOrd()
Dim Fundet(100, 5) As String, Sted(100) As String, Søg As Variant, I As Integer, T As Integer
Dim R As Integer
I = 1
On Error Resume Next
Sheets("Forside").Select
  Range("B2:H201").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", "Find medicinske præparater")
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 Error = 91 Then
        Err.Clear
        If I > 1 Then I = I - 1
        GoTo Videre
        End If
        a = ActiveCell.Row
        If a = 1 Then GoTo Videre
        b = ActiveCell.Column
        Cells(a, b).Activate
        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 Error = 91 Then
        Err.Clear
        If I > 1 Then I = I - 1
        GoTo Videre
        End If
        a = ActiveCell.Row
          If a = 1 Then GoTo Videre
        b = ActiveCell.Column
        Cells(a, b).Activate
        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)
      ActiveCell = Sted(T)
      Next
      Next
      If I = 1 Then
      MsgBox " ingen fundet"
      End If
End Sub

Det ser rigtig godt ud det du der har lavet. Er det muligt OGSÅ at få en hyperlink til området hvor de findes?