14. januar 2004 - 14:02Der er
10 kommentarer og 1 løsning
Søgeresultat i listbox
Hej
Jeg har lavet en søgning som jeg gerne ville vise i en listbox (Userform1.listbox1) men jeg har en anelse svært ved at finde den rigtige metode. Jeg har tidl fået hjælp til tilsvarende blot med søgning fra access men jeg synes ikke at det har hjulpet :0( Her er koden (der lægger resultatet ind i resultat - den mellemregning ville det være dejligt at slippe for):
Sub FindEfterlysteDyr() Sheets("Resultat").Range("A2:G1000").ClearContents Application.ScreenUpdating = False Dim Søg As String, twb As Workbook Set twb = ThisWorkbook Søg = InputBox("Indtast søgetekst") If Søg <> "" Then With Sheets("Efterlyste dyr").Range("C3:D1000")
Set s = .Find(Søg, LookIn:=xlValues) If Not s Is Nothing Then firstAddress = s.Address Do
Set s = .FindNext(s)
If Left(s.Address, 2) = "$C" Then With Sheets("Resultat").Range("C65536").End(xlUp) .Offset(1, -1) = s.Value .Offset(1, -2) = s.Offset(0, -2).Value .Offset(1, 0) = s.Offset(0, 1).Value .Offset(1, 1) = s.Offset(0, 2).Value .Offset(1, 2) = s.Offset(0, 3).Value .Offset(1, 3) = s.Offset(0, 4).Value .Offset(1, 4) = s.Offset(0, 5).Value End With ElseIf Left(s.Address, 2) = "$D" Then With Sheets("Resultat").Range("D65536").End(xlUp) .Offset(1, -1) = s.Value .Offset(1, -2) = s.Offset(0, -1).Value .Offset(1, -3) = s.Offset(0, -3).Value .Offset(1, 0) = s.Offset(0, 1).Value .Offset(1, 1) = s.Offset(0, 2).Value .Offset(1, 2) = s.Offset(0, 3).Value .Offset(1, 3) = s.Offset(0, 4).Value End With End If
Loop While Not s Is Nothing And s.Address <> firstAddress MsgBox ("Fundne dyr ses på arket resultat")
Else: MsgBox ("Ikke fundet") Exit Sub
End If End With Exit Sub Else MsgBox ("Søgetekst skal indtastes") End If
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
jeg har ikke rettet i din programering, bare tilføjet.
Sub FindEfterlysteDyr() Sheets("Resultat").Range("A2:G1000").ClearContents UserForm1.ListBox1.Clear ' NY Application.ScreenUpdating = False Dim Søg As String, twb As Workbook Set twb = ThisWorkbook Søg = InputBox("Indtast søgetekst") If Søg <> "" Then With Sheets("Efterlyste dyr").Range("C3:D1000")
Set s = .Find(Søg, LookIn:=xlValues) If Not s Is Nothing Then firstAddress = s.Address Do
-->kabbak Tja med risiko for at lyde som en grammofonplade med ridser i: Du kan bare det gylde!!! (undskyld det forslidte udtryk). Der er fortsat lidt arbejde med bredden i kolonnerne men det skulle jeg vist kunne klare. Tusinde tak for hjælpen. Hilsen Steen NB! Husk lige at svare
Er rettet, du skal sætte din listbox til 6 kolonner.
Jeg bruger dit resultat ark til at hente daterna fra.
Sub FindEfterlysteDyr() Dim Data As Variant ' NY Sheets("Resultat").Range("A2:G1000").ClearContents UserForm1.ListBox1.Clear ' NY Application.ScreenUpdating = False Dim Søg As String, twb As Workbook Set twb = ThisWorkbook Søg = InputBox("Indtast søgetekst") If Søg <> "" Then With Sheets("Efterlyste dyr").Range("C3:D1000")
Set s = .Find(Søg, LookIn:=xlValues) If Not s Is Nothing Then firstAddress = s.Address Do
Set s = .FindNext(s)
If Left(s.Address, 2) = "$C" Then With Sheets("Resultat").Range("C65536").End(xlUp) .Offset(1, -1) = s.Value .Offset(1, -2) = s.Offset(0, -2).Value .Offset(1, 0) = s.Offset(0, 1).Value .Offset(1, 1) = s.Offset(0, 2).Value .Offset(1, 2) = s.Offset(0, 3).Value .Offset(1, 3) = s.Offset(0, 4).Value .Offset(1, 4) = s.Offset(0, 5).Value End With ElseIf Left(s.Address, 2) = "$D" Then With Sheets("Resultat").Range("D65536").End(xlUp) .Offset(1, -1) = s.Value .Offset(1, -2) = s.Offset(0, -1).Value .Offset(1, -3) = s.Offset(0, -3).Value .Offset(1, 0) = s.Offset(0, 1).Value .Offset(1, 1) = s.Offset(0, 2).Value .Offset(1, 2) = s.Offset(0, 3).Value .Offset(1, 3) = s.Offset(0, 4).Value End With
End If
Loop While Not s Is Nothing And s.Address <> firstAddress ' MsgBox ("Fundne dyr ses på arket resultat") A = Sheets("Resultat").Range("D65536").End(xlUp).Row 'NY Data = Sheets("Resultat").Range("A2:F" & A) 'NY UserForm1.ListBox1.List() = Data 'NY Else: MsgBox ("Ikke fundet") Exit Sub
End If End With UserForm1.Show ' NY
Exit Sub Else MsgBox ("Søgetekst skal indtastes") End If End Sub
Tak for hjælpen endnu en gang. Har du mulighed for at kigge med på: http://www.eksperten.dk/spm/452446 Som omhandler det du har lavet (blot den anden vej)
Hilsen Steen
Synes godt om
Ny brugerNybegynder
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.
