Flere afhængige dropdown menuer

Kunne det være i en Userform(dialogboks), der henter data fra selve Excel-arket og leverer resultatet i arket igen?

Du kan også anvende et filter, hvis du udfylder alle felterne i hver linie, hvilket kommer til at se således ud:

1    Butik  | Frugt  | Æble  | Rød    | Grøn  | Gul  |
2    Butik  | Frugt  | Æble | Pære  | Rund  | Lang  |
3    Butik  | Frugt  | Æble | Drue    | Sød    | Sur    |

osv...

Ved automatisk filter får du en dropdown knap, hvor man kan vælge til og fra på hver enkelt kolonne.

Du skriver ikke noget om kravet til brugerinterface, så jeg går ud fra at du kan anvende denne metode.

@japping
Jeg skulle gerne bruge et ark som "input" ark og så have alle opslags dataene på et separat ark. så filter er ikke muligt at bruge.

@supertekst
Jeg har ikke arbejdet med userforms før, så ved ikke om det er muligt. Men vil lige kigge på mulighederne.

Det skal siges Data arket har ca 200 Rækker og op til 25 kolonner

Ved ikke om det gør nogen forskel

Har du mulighed for at sende filen? @-adr. under profil.

Vba-kode i Userform - en listbox viser de udført valg:

Dim ddTabel(4, 3) As Integer
Dim errorData As Worksheet, inputData As Worksheet

Dim niveauNr As Byte, maxRæk As Integer, maxKol As Integer, maxNiveau As Byte
Dim kol As Integer, rækStart As Integer, rækSlut As Integer
Dim niveauTekst As String, spinFlag As Boolean
Private Sub SpinButton1_spinUp()
    If niveauNr + 1 <= 4 Then
        niveauNr = niveauNr + 1
        spinResult
       
        ajfLabel niveauNr, Me.ListBox1.List(ddTabel(niveauNr, 1))
    End If
End Sub
Private Sub SpinButton1_spinDown()
    If niveauNr - 1 >= 1 Then
        ajfLabel niveauNr, ""

        niveauNr = niveauNr - 1
        spinResult
    End If
End Sub
Private Sub spinResult()
        rækStart = ddTabel(niveauNr, 2)
        rækSlut = ddTabel(niveauNr, 3)
       
        If rækStart > 0 And rækSlut > 0 Then
            visNiveau niveauNr
           
            Me.ListBox1.ListIndex = ddTabel(niveauNr, 1)
        End If
End Sub
Private Sub UserForm_activate()
    Set inputData = ActiveWorkbook.Sheets("Input")
    Set errorData = ActiveWorkbook.Sheets("Error Data")
   
    maxNiveau = 0
   
    With errorData
        maxRæk = .Cells(1, 1).SpecialCells(xlLastCell).Row
        maxKol = .Cells(1, 1).SpecialCells(xlLastCell).Column
    End With
   
    niveauNr = 1
    rækStart = 2
    rækSlut = maxRæk
   
    visNiveau niveauNr
End Sub
Private Sub visNiveau(nr)
Dim ræk As Integer, kol As Integer, tekst As String
    Me.ListBox1.Clear
   
Rem Valg-mulighed i kolonnen
    If nr >= 1 And nr <= 3 Then
        kol = nr
        Me.ListBox1.Clear
       
        For ræk = rækStart To rækSlut
            If Trim(errorData.Cells(ræk, kol)) <> "" Then
                Me.ListBox1.AddItem errorData.Cells(ræk, kol)
            End If
        Next ræk
    Else
Rem Valg-mulighed i rækken
        If niveauNr = 4 And rækStart > 0 Then
            Me.ListBox1.Clear
       
            For kol = niveauNr To maxKol
                If Trim(errorData.Cells(rækStart, kol)) <> "" Then
                    Me.ListBox1.AddItem errorData.Cells(rækStart, kol)
                End If
            Next kol
        End If
    End If
   
    Me.ListBox1.ListIndex = -1
End Sub
Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    If Me.ListBox1.ListIndex <> -1 Then
        niveauTekst = Me.ListBox1
        ddTabel(niveauNr, 1) = Me.ListBox1.ListIndex
        ddTabel(niveauNr, 2) = rækStart
        ddTabel(niveauNr, 3) = rækSlut

        ajfLabel niveauNr, niveauTekst
       
        If niveauNr > 0 And niveauNr < 4 Then
            findRækNr niveauTekst
           
            niveauNr = niveauNr + 1
            If niveauNr > maxNiveau Then
                maxNiveau = niveauNr
            End If
           
            visNiveau niveauNr
        End If
    End If
End Sub
Private Sub findRækNr(tekst)
Dim område As String, r As Integer
    område = Chr(64 + niveauNr) & CStr(rækStart) & ":" & Chr(64 + niveauNr) & CStr(rækSlut)
    With errorData.Range(område)
        Set c = .Find(tekst, LookIn:=xlValues, LookAt:=xlWhole)
        If Not c Is Nothing Then
            rækStart = c.Row
            rækSlut = maxRæk
           
            For r = rækStart + 1 To maxRæk
                If Range(Chr(64 + niveauNr) & CStr(r)) <> "" Then
                    rækSlut = r - 1
                    Exit For
                End If
            Next r
        Else
            rækStart = 0
        End If
    End With
End Sub
Private Sub ajfLabel(nr, indhold)
Dim cc As Control
    Set cc = UserForm1.Controls("Label" & CStr(nr))
    cc.Caption = indhold
End Sub

Super godt.

Tusind tak for hjælpen.

selv tak..