programering
Hej EksperterJeg har et problem som jeg håber der er en eller anden der kan hjælpe mig med?
infomation om årsagen til problemet.
jeg har et vare katalog med en masse priser og infoformationer om div. anlæg osv. for at gøre det så nemt og overskueligt som muligt har jeg lavet et excel ark med vba. jeg har en userform med tre søge kriterier, når man søger i felt 1 for man kun dem der matcher felt 1 i felt 2 og det samme i felt 3.
når man så trykker søg kommer alle informationerne om anlægget automatisk i excel arket.
Mit problem.
Hvis der er flere anlæg der matcher de 3 søge kriterier vælger excel selv en af dem og udfylder arket med infomationer uden at man har mulighed for at vælge i mellem dem.
Det jeg godt kunne tænke mig hjælp til er at få en liste i min userform hvor jeg kan vælge hvis der er flere anlæg der matcher mine søge kriterier?
min kode som den ser ud nu.
Dim kildeArkRækker As Integer
Private Sub cb_søg_click()
Dim ræk As Integer, kw As Double, tilslutning As String, indeUde As String
With Sheets("prisliste anlæg")
kw = Me.Com_kw
tilslutning = Me.Com_tilslutning
indeUde = Me.Com_indeude
For ræk = 2 To kildeArkRækker
If kw = .Range("H" & ræk) And tilslutning = .Range("G" & ræk) And InStr(.Range("B" & ræk), indeUde) > 0 Then
Range("A" & Sheets("tilbudsark").xRæk) = kw
Range("B" & Sheets("tilbudsark").xRæk) = tilslutning
Range("C" & Sheets("tilbudsark").xRæk) = indeUde
Range("E" & Sheets("tilbudsark").xRæk) = .Range("B" & ræk) 'model
Range("F" & Sheets("tilbudsark").xRæk) = .Range("J" & ræk) 'bredde
Range("G" & Sheets("tilbudsark").xRæk) = .Range("K" & ræk) 'dybde
Range("H" & Sheets("tilbudsark").xRæk) = .Range("L" & ræk) 'højde
Range("I" & Sheets("tilbudsark").xRæk) = .Range("M" & ræk) 'vægt
Range("J" & Sheets("tilbudsark").xRæk) = .Range("O" & ræk) 'støjniveau
Range("K" & Sheets("tilbudsark").xRæk) = .Range("A" & ræk) 'artikelnummer
Range("L" & Sheets("tilbudsark").xRæk) = .Range("E" & ræk) 'pris
End If
Next ræk
Columns("E:E").EntireColumn.AutoFit
End With
End Sub
Private Sub Cb_søg_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
End Sub
Rem XXXXXXXXXXXXXXXXXXXXXXXXXXX
Private Sub Com_kw_Change()
Me.Com_tilslutning.Clear
Me.Com_indeude.Clear
' Me.Lb_model.Clear
hentTilslutning Me.Com_kw
End Sub
Private Sub Com_tilSlutning_Change()
Me.Com_indeude.Clear
' Me.Lb_model.Clear
hentIndeUde
End Sub
Rem XXXXXXXXXXXXXXXXXXXXXXXXXXX
Private Sub UserForm_Activate()
houseKeeping
End Sub
Private Sub houseKeeping()
rydListBokse
hentKW
End Sub
Private Sub rydListBokse()
With Me
Me.Com_kw.Clear
Me.Com_tilslutning.Clear
Me.Com_indeude.Clear
' Me.Lb_model.
End With
End Sub
Private Sub hentKW()
Dim ræk As Integer, kw As Double, kwPulje As String, tabel As Variant
Dim ix As Integer
With Sheets("prisliste anlæg")
kwPulje = ""
kildeArkRækker = .Cells(Rows.Count, "A").End(xlUp).Row
For ræk = 2 To kildeArkRækker
kw = .Range("H" & ræk)
If InStr(kwPulje, kw) = 0 Then
kwPulje = kwPulje & kw & ";"
End If
Next ræk
End With
tabel = Split(kwPulje, ";")
For ix = 0 To UBound(tabel) - 1
Me.Com_kw.AddItem tabel(ix)
Next ix
Me.Com_kw.DropDown
End Sub
Rem ===========================
Private Sub hentTilslutning(kw)
Dim ræk As Integer, tS As String, tSPulje As String, tabel As Variant
Dim ix As Integer
With Sheets("prisliste anlæg")
For ræk = 2 To kildeArkRækker
tS = .Range("G" & ræk)
If InStr(tSPulje, tS) = 0 And .Range("H" & ræk) = CStr(kw) Then
tSPulje = tSPulje & tS & ";"
End If
Next ræk
End With
tabel = Split(tSPulje, ";")
For ix = 0 To UBound(tabel) - 1
Me.Com_tilslutning.AddItem tabel(ix)
Next ix
Me.Com_tilslutning.DropDown
End Sub
Rem ===========================
Private Sub hentIndeUde()
Me.Com_indeude.AddItem "INDOOR"
Me.Com_indeude.AddItem "OUTDOOR"
Me.Com_indeude.AddItem "WALL"
Me.Com_indeude.AddItem "FLOOR"
Me.Com_indeude.AddItem "CEILING"
Me.Com_indeude.AddItem "DUCT"
Me.Com_indeude.DropDown
End Sub
Hvis der er en venlig sjæl der kan hjælpe mig med dette vil jeg blive glad
VH DF81