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 lang tid har samarbejdsbranchen fokuseret på at forbedre enhedsfunktioner – bedre kameraer, klarere lyd og smartere software. Men den virkelige forvandling handler ikke om funktioner.
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.
