Søge i på svære navne

Hvor mange "kunder" er der tale om?
Er alle data i samme ark?
Er de relevante data kun dem, som viser?

Der kan konstrueres en Userform (en form for dialogboks) hvori de givne oplysninger kan indtastes. Selve funktioneringen vil da være baseret på programmeringssproget VBA
til Excel.

På dette grundlag kan der uden tvivl udføres en søgning, der viser hvilke mulige kunder, der kunne være tale om - idet søgningen kan tage hensyn til de specielle bogstaver (æ, ø, å + tilsvarende nordiske).

Ja alle data er i samme ark. Der er måske 50 forskellige selskaber, der hver har 50 typer forsikringer det er alene 250 muligheder. Der er ved 500 firmaer fordelt på primært Danmark, Norge og Sverige. Det svinger en del hvormange kunder der ringer ind. Nogle dage er det kun 10, andre dage er det 50.

Opgaven kan løses på mange måder, lige fra det avancerede med Userforms og VBA (som supertekst skriver), til en simpel løsning med "autofilter" på kolonnerne:

Markér cellerne med dine overskrifter: Land, Firma, Sel..
Vælg fra Excel menuen: "Data" => "Filter" => "Autofilter".

Der fremkommer nu nogle små grå pile i rækken med overskrifter, hvorved du kan vælge at se data fra f.eks. kun "N". Bemærk at pilen skifter fra sort til blå, når der er foretaget valg. Når der ringes ind, f.eks. fra Norge, sættes filter på "N", personen er fra "Ålesund Oliespild", der vælges under "Firma#. Nu vises kun rækken/rækkerne med "N" OG "Ålesund Oliespild". Under Selskab ses nu kun de(t) "Selskab"/"Type" der kan være tale om.

NB! autofilter virker kun hvis der ikke er tomme linier. Virker også når der tilføjes flere rækker.

PS: Skal det være lidt mere avanceret kan der laves en lille makro, der "nulstiller" valgene med "autofilter".

jaako metoden er sådan quick and dirty. Jeg hælder mere til Userforms, da jeg sagtens kan se at folk laver ged i de lister. Jeg er ikke så glad for, at brugerne kan se alle listerne, for at holde det så simpelt som muligt.

Har eksperimenteret lidt med LOPSLAG til den her opgave. Det virker fint, men begrænsningen er, hvis der er 2 firmaer med samme navn:

=LOPSLAG(L4;A1:D26;1;FALSK)
=LOPSLAG(L4;A1:D26;2;FALSK)
=LOPSLAG(L4;A1:D26;3;FALSK)
=LOPSLAG(L4;A1:D26;4;FALSK)

Her returnes alt fra tabellerne, og nu begynder det at ligne noget. Man kan desværre ikke søge på et land eller et selskab, da flere firmaer deler den værdi...

Hvad skal jeg gøre???

Er igang med en Userform og med "skjult adgang" til Kundefilen - vender tilbage...

Hvis du sender en mail til: pb@supertekst-it.dk
så returnerer jeg system-model1.

mail sendt :)

Mht. filter-løsning kan du sikre dig imod at nogle retter eller sletter ved at beskytte din fil, sådan at der ikke kan rettes i den af andre end de der kender et password. Vælg fra Excel-menuen: "Tools" => "Protect sheet". Indtast og bekræft det ønskede password. Nuvel, held og lykke med Userform løsningen!

Superdupertekst kan du ikke lige skrive et svar. De point er rigtig godt givet ud.

Koden i Userformen blev så følgende:

Dim xlsKunder, sti, antalKunder
Private Sub cb_Luk_Click()
    lukKunder
    Unload UserForm1
End Sub
Private Sub cb_Søg_Click()                          'Udfør søgning
Dim points, score
Dim sLand, sFirma, sSelskab, sType
Dim kLand, kFirma, kSelskab, kType
    sLand = ""
    sFirma = ""
    sSelskab = ""
    sType = ""
   
    points = 0
    If Me.lb_Lande.ListIndex <> -1 Then
        sLand = LCase(Me.lb_Lande)
        points = points + 1
    End If
   
    sFirma = LCase(Me.tb_Firma)
    If sFirma <> "" Then
        points = points + 1
    End If
   
    If Me.lb_Selskab.ListIndex <> -1 Then
        sSelskab = LCase(Me.lb_Selskab)
        points = points + 1
    End If
   
    If Me.lb_Typer.ListIndex <> -1 Then
        sType = LCase(Me.lb_Typer)
        points = points + 1
    End If
   
   
    Me.lb_Søgeresultat.Clear
   
Rem Test søgekriterier
    For ræk = 2 To antalKunder
        score = 0
        With xlsKunder.Sheets(1)
            kLand = LCase(.Cells(ræk, 1))
            kFirma = LCase(.Cells(ræk, 2))
            kSelskab = LCase(.Cells(ræk, 3))
            kType = LCase(.Cells(ræk, 4))
           
            If sLand <> "" Then
                If sLand = kLand Then
                    score = score + 1
                End If
            End If
           
            If sFirma <> "" Then
                If InStr(kFirma, sFirma) > 0 Then
                    score = score + 1
                End If
            End If
           
            If sSelskab <> "" Then
                If sSelskab = kSelskab Then
                    score = score + 1
                End If
            End If
           
            If sType <> "" Then
                If sType = kType Then
                    score = score + 1
                End If
            End If
           
            If score = points Then
                Me.lb_Søgeresultat.AddItem kLand
                Me.lb_Søgeresultat.List(Me.lb_Søgeresultat.ListCount - 1, 1) = kFirma
                Me.lb_Søgeresultat.List(Me.lb_Søgeresultat.ListCount - 1, 2) = kSelskab
                Me.lb_Søgeresultat.List(Me.lb_Søgeresultat.ListCount - 1, 3) = kType
            End If
        End With
    Next ræk
End Sub
Private Function søgFirma(tekst)
    With xlsKunder.Sheets(1)
    Columns("B:B").Select
    Selection.Find(What:=tekst, After:=ActiveCell, LookIn:=xlValues, LookAt _
        :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
       
    End With
End Function

Private Sub CommandButton1_Click()
    Me.lb_Søgeresultat.Clear
    Me.lb_Lande.ListIndex = -1
    Me.tb_Firma = ""
    Me.lb_Selskab.ListIndex = -1
    Me.lb_Typer.ListIndex = -1
End Sub
Private Sub lb_Lande_Click()
    testOmDerKanSøges
End Sub
Private Sub lb_Lande_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.lb_Lande.ListIndex = -1
    testOmDerKanSøges
End Sub
Private Sub lb_Selskab_Click()                      'selskab valgt
  visForsikringsTyper Me.lb_Selskab
  testOmDerKanSøges
End Sub
Private Sub lb_Selskab_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.lb_Selskab.ListIndex = -1
    Me.lb_Typer.Clear
    testOmDerKanSøges
End Sub

Private Sub tb_firma_Change()
    testOmDerKanSøges
End Sub
Private Sub tb_Firma_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Me.tb_Firma = ""
End Sub
Private Sub UserForm_activate()
    sti = findSti
   
    åbnKunder
   
    opbygLande
    opbygSelskaber
   
    Me.lb_Søgeresultat.ColumnCount = 4
    Me.lb_Søgeresultat.ColumnWidths = "150;150;150;150"
   
    Me.cb_Søg.Enabled = False
End Sub
Private Function findSti()
    findSti = ActiveWorkbook.Path
    If Right(sti, 1) <> "\" Then
        findSti = findSti + "\"
    End If
End Function
Private Sub åbnKunder()
    Set xlsKunder = CreateObject("Excel.Application")
    With xlsKunder
        .Workbooks.Open sti + "kunder.xls"
        .ActiveWorkbook.Sheets(1).Activate
        antalKunder = .ActiveCell.SpecialCells(xlLastCell).Row
    End With
End Sub
Private Sub lukKunder()
    xlsKunder.Application.Quit
    Set xlsKunder = Nothing
End Sub
Private Sub opbygLande()
    Me.lb_Lande.Clear
    With xlsKunder
        For ræk = 2 To antalKunder
            land = .Cells(ræk, 1)
Rem Test om findes i forvejen
            If FindesLand(land) = False Then
                Me.lb_Lande.AddItem land
            End If
        Next ræk
    End With
End Sub
Private Function FindesLand(land)
    For f = 0 To Me.lb_Lande.ListCount - 1
        If LCase(land) = LCase(Me.lb_Lande.List(f)) Then
            FindesLand = True
            Exit Function
        End If
    Next f
    FindesLand = False
End Function
Private Sub opbygSelskaber()
    Me.lb_Selskab.Clear
    With xlsKunder
        For ræk = 2 To antalKunder
            selskab = .Cells(ræk, 3)
Rem Test om findes i forvejen
            If FindesSelskab(selskab) = False Then
                Me.lb_Selskab.AddItem selskab
            End If
        Next ræk
    End With
End Sub
Private Function FindesSelskab(selskab)
    For f = 0 To Me.lb_Selskab.ListCount - 1
        If LCase(selskab) = LCase(Me.lb_Selskab.List(f)) Then
            FindesSelskab = True
            Exit Function
        End If
    Next f
    FindesSelskab = False
End Function
Private Sub visForsikringsTyper(selskab)
    Me.lb_Typer.Clear
    With xlsKunder
        For ræk = 2 To antalKunder
            If LCase(.Cells(ræk, 3)) = LCase(selskab) Then
                If FindesType(.Cells(ræk, 4)) = False Then
                    Me.lb_Typer.AddItem .Cells(ræk, 4)
                End If
            End If
        Next ræk
    End With
End Sub
Private Function FindesType(fType)
    For f = 0 To Me.lb_Typer.ListCount - 1
        If LCase(fType) = LCase(Me.lb_Typer.List(f)) Then
            FindesType = True
            Exit Function
        End If
    Next f
    FindesType = False
End Function
Private Sub testOmDerKanSøges()
    If Me.lb_Lande.ListIndex <> -1 Or Me.tb_Firma <> "" Or Me.lb_Selskab.ListIndex <> -1 Then
        Me.cb_Søg.Enabled = True
    Else
        Me.cb_Søg.Enabled = False
    End If
End Sub
Private Sub UserForm_Terminate()
On Error Resume Next
    lukKunder
End Sub

Kan lukkes :)