Avatar billede DF81 Mester
07. august 2017 - 11:44

programering

Hej Eksperter
Jeg 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
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Kurser inden for grundlæggende programmering

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester