15. april 2005 - 18:00Der er
9 kommentarer og 1 løsning
Excel for rigtige eksperter!!
Jeg har lavet en lille database i excel. Nedenstående kode søger efter 3 ord som bruger vælger i userform. Hvis disse 3 ord forekommer i samme række vises disse rækker i listebox. Det virker bortset fra hvis jeg for eksempel vælger søgeord "Protein" og samtidig har i en række disse ord: Protein og Protein.pdf. Programmet forstyres åbenbart hvis et søgerord forekommer i samme række mere end en gang. Hvordan kan jeg løse det? Her er code: Private Sub CommandButton1_Click()
Dim sOne, sOneItem With Me .ListBox1.RowSource = "" .ListBox1.ColumnCount = 3 .ListBox1.Clear End With
With UserForm1 '****** If .OptionButton1 Then sOne = Array("Hest") If .OptionButton2 Then sOne = Array("Grise") If .OptionButton5 Then sOne = Array("Hest", "Grise") '****** If .OptionButton3 Then sTwo = "Artikel" Else sTwo = "Figur" End If sThree = .TextBox1.Text End With
'****** For Each sOneItem In sOne '****** 'MsgBox sOneItem With Worksheets(1).Cells Set C = .Find(sOneItem, LookIn:=xlValues) If Not C Is Nothing Then firstAddress = C.Address Do If Application.CountIf(C.EntireRow, "*" & sTwo & "*") And _ Application.CountIf(C.EntireRow, "*" & sThree & "*") Then UserForm1.ListBox1.AddItem UserForm1.ListBox1.List( _ UserForm1.ListBox1.ListCount - 1, 0) _ = C.Offset(0, -3).Value UserForm1.ListBox1.List( _ UserForm1.ListBox1.ListCount - 1, 1) _ = C.Offset(0, -1).Value UserForm1.ListBox1.List( _ UserForm1.ListBox1.ListCount - 1, 2) _ = C.Offset(0, 4).Value
End If Set C = .FindNext(C) Loop While Not C Is Nothing And C.Address <> firstAddress End If End With '****** Next '****** End Sub
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.
Dim sOne, sOneItem Dim rgSearchRange As Range Set rgSearchRange = Sheets(1).Range("D1:D" & Range("D65536").End(xlUp).Row) With Me .ListBox1.RowSource = "" .ListBox1.ColumnCount = 3 .ListBox1.Clear End With
With UserForm1 '****** If .OptionButton1 Then sOne = Array("Hest") If .OptionButton2 Then sOne = Array("Grise") If .OptionButton5 Then sOne = Array("Hest", "Grise") '****** If .OptionButton3 Then sTwo = "Artikel" Else sTwo = "Figur" End If sThree = .TextBox1.Text End With
'****** For Each sOneItem In sOne '****** Set c = rgSearchRange.Find(sOneItem, LookIn:=xlValues) If Not c Is Nothing Then firstAddress = c.Address Do
If (Application.CountIf(c.EntireRow, "*" & sTwo & "*") > 0 And _ Application.CountIf(c.EntireRow, "*" & sThree & "*") > 0) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = Cells(c.Row, 1).Value 'Kol A .List(.ListCount - 1, 1) = Cells(c.Row, 3).Value 'Kol C .List(.ListCount - 1, 2) = Cells(c.Row, 8).Value 'kol H End With End If Set c = rgSearchRange.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress End If '****** Next '****** End Sub
Her er en lidt forbedret version. Forbedring ligger i at alle variable er dimensioneret, samt at du ikke nødvendigvis bebøver at vise ark1 samtidig med at userfomen køres. Den kan udemærket køres fra Ark3
Private Sub CommandButton1_Click()
Dim sOne As Variant Dim sOneItem As Variant Dim rgSearchRange As Range Dim sh As Worksheet Dim FirstAddress As String Dim sTwo As String Dim sThree As String Dim C As Range
Set sh = ThisWorkbook.Sheets(1) Set rgSearchRange = sh.Range("D1:D" & sh.Range("D65536").End(xlUp).Row) With Me.ListBox1 .RowSource = "" .ColumnCount = 3 .Clear End With
With Me '****** If .OptionButton1 Then sOne = Array("Hest") If .OptionButton2 Then sOne = Array("Grise") If .OptionButton5 Then sOne = Array("Hest", "Grise") '****** If .OptionButton3 Then sTwo = "Artikel" Else sTwo = "Figur" End If sThree = .TextBox1.Text End With
'****** For Each sOneItem In sOne '****** Set C = rgSearchRange.Find(sOneItem, LookIn:=xlValues) If Not C Is Nothing Then FirstAddress = C.Address Do
If (Application.CountIf(C.EntireRow, "*" & sTwo & "*") > 0 And _ Application.CountIf(C.EntireRow, "*" & sThree & "*") > 0) Then With Me.ListBox1 .AddItem .List(.ListCount - 1, 0) = sh.Cells(C.Row, 1).Value 'Kol A .List(.ListCount - 1, 1) = sh.Cells(C.Row, 3).Value 'Kol C .List(.ListCount - 1, 2) = sh.Cells(C.Row, 8).Value 'kol H End With End If Set C = rgSearchRange.FindNext(C)
Loop While Not C Is Nothing And C.Address <> FirstAddress End If '****** Next '****** 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.
