Fedeste funktion du har fundet i excel.

Funktionen Split - anvendt ved <---------------- markeringen:

Rem Koden er udarbejdet i 2003-versionen - reference til OutLook er sat
Rem ===================================================================
Rem www.contextmagic.com/express-clickyes/
Rem ======================================
Rem På ovennævnte site kan der downloades kode, der undertrykker meddelelsen "Et program prøver at.."
Rem (Har anvendt det i flere år - uden problemer)
Rem =================================================================================================
Private Sub testMail()
Dim mailApp, Namespace, indbakke, m, sidsteLinie As String, række

On Error GoTo afslut

Rem Opsætter "forbindelse til indbakken"
    Set mailApp = CreateObject("Outlook.Application")
    Set Namespace = mailApp.GetNamespace("MAPI")
    Set indbakke = Namespace.GetDefaultFolder(olFolderInbox)
   
Rem Traversere indbakken
    If indbakke.Items.Count > 0 Then
        For m = 1 To indbakke.Items.Count
            emne = indbakke.Items(m).Subject
                       
Rem Tester emne-teksten - eksempel "Eksempel på mail" med start i første pos.
            If InStr(emne, "Eksempel på mail") = 1 Then
           
Rem Hvis ja - overfør meddelelsesteksten til variablen Tekst
                tekst = indbakke.Items(m).Body

Rem fang antal tegn i meddelelsen
                antaltegn = Len(tekst)
               
                sidsteLinie = ""
Rem Traverser gennem Tekst med start i sidste tegn og opbyg sidste linie tegnvist
                For t = antaltegn To 1 Step -1
                    tegn = Mid(tekst, t, 1)
                    sidsteLinie = tegn + sidsteLinie
                   
                   
Rem Test om linieskift / ny linie - hvis ja - afslut gennemløb
                    If InStr(sidsteLinie, Chr(13) & Chr(10)) = 1 Then
                        If Len(sidsteLinie) > 2 Then
                            Exit For
                        Else
                            If Len(sidsteLinie) = 2 Then
                                sidsteLinie = ""
                            End If
                        End If
                    End If
                Next t
               
Rem Fjern linieskift / ny linie i pos.1
                sidsteLinie = Mid(sidsteLinie, 3) + ";"
                MsgBox (sidsteLinie)                'kontrol kan slettes eller elimineres...(Rem eller ')
               
Rem opsplit de enkelte elementer
                elementer = Split(sidsteLinie, ";")    '<----------------------------
                antalelementer = UBound(elementer)
               
Rem sæt dem i regnearket
                række = 1                          'temp. løsning....
               
                For a = 0 To antalelementer - 1
                    Cells(række, 1 + a) = elementer(a)
                Next a
            End If
           
            Columns.AutoFit
        Next m
    End If
   
   
    MsgBox ("Gennemløb afsluttet")
afslut:
End Sub

Kan godt li' funktionerne Indirekte og Sammenkædning. Et eksempel kan ses her:
http://www.humyo.com/F/6451231-280544521/Y2FiNzI2MjhkMzlkMzljM2Y4ZTMyNjhiYjEwZDg3MzE=

I eksemplet er der også anvendt Datavalidering og Navnestyring.

SUMPRODUKT er en af de mere geniale funktioner, fordi den kan bruges til så meget, ikke mindst i kombinatione med andre funktioner. Se fx her:

=FORSKYDNING(INDIREKTE(ADRESSE(SUMPRODUKT((A1:D5="Olsen")*(RÆKKE(A1:D5)));SUMPRODUKT((A1:D5="Olsen")*(KOLONNE(Ark1!A1:D5)))));2;-3)

leder efter Olsen i en matrix og returnerer det, som står 2 rækker under og 3 kolonner til venstre for celleb med Olsen :-)

I det hele taget muligheden for at løse opgaver ved at kombinere diverse funktioner.

STØRSTE(HVIS(FREKVENS(A1:A5;A1:A5)>0;A1:A5);2)

returner den næststørste, unikke værdi i et område.

Også matrixformler er ret spændende.

Og så selvfølgelig muligheden for at programmere egne funktioner, som fx

Function RTSUM(ce As String) As Double
    Dim cif As Double
    Dim caf As Long


    For i = 1 To Len(ce)
        cif = cif + CByte(Mid(ce, i, 1))
    Next
igen:
    For i = 1 To Len(CStr(cif))
        caf = caf + CByte(Mid(cif, i, 1))
    Next
    If Len(CStr(caf)) > 1 Then
        cif = caf
        caf = 0
        GoTo igen
    End If
    RTSUM = caf
End Function

Der beregner den reducerede tværsum af tallet i en celle.

Denne Brugerdefinerede,der kan summere farvede celler, jeg tror at det er bak der har lavet den.

Function ColorCount(rRange As Range, rColor As Range) As Double
    Dim rCell As Range
    Dim dCount As Double
    dCount = 0
    Application.Volatile
    For Each rCell In rRange
        If rCell.Interior.ColorIndex = rColor.Interior.ColorIndex Then
            dCount = dCount + rCell
        End If
    Next rCell
    ColorCount = dCount
End Function

Funktionen Betinget formatering synes jeg er rigtig god, eneste fejl er at den indbyggede funktion kun giver 3 valg ved hjælp af kode kan der vælges op til 56 farver i samme celle.

Denne kode styrer farven i kolonne F ved ænding i kolonne A i samme række.

Private Sub Worksheet_Change(ByVal Target As Range)
‘Da arket er skrivebeskyttet skal den ophæves inden koden køres
ActiveSheet.Unprotect
Dim C As Range
'marker celle A6:A95
Range("A6:A95").Activate
For Each C In Selection.Cells

'hvis en celle i kolonne A indeholder et l farves kolonne F, i samme række, grøn og teksten sort.
    If C.Value = "b" Then
        'farv cellen i kolonne I med farve 3
        C.Offset(0, 5).Interior.ColorIndex = 4
        C.Offset(0, 5).Font.ColorIndex = 1
    ElseIf C.Value = "l" Then
'hvis en celle i kolonne A indeholder et p farves kolonne F i samme række gul og teksten sort.
        C.Offset(0, 5).Interior.ColorIndex = 6
        C.Offset(0, 5).Font.ColorIndex = 1
    ElseIf C.Value = "u" Then
'hvis en celle i kolonne A indeholder et u farves kolonne F i samme række orange og teksten sort.
        C.Offset(0, 5).Interior.ColorIndex = 4
        C.Offset(0, 5).Font.ColorIndex = 1
    ElseIf C.Value = "f" Then
'hvis en celle i kolonne A indeholder et f farves kolonne F i samme række rød og teksten hvid.
        C.Offset(0, 5).Interior.ColorIndex = 3
        C.Offset(0, 5).Font.ColorIndex = 2
ElseIf C.Value = "h" Then
'hvis en celle i kolonne A indeholder et h farves kolonne F i samme række blå og teksten hvid.
        C.Offset(0, 5).Interior.ColorIndex = 41
        C.Offset(0, 5).Font.ColorIndex = 2
ElseIf C.Value = "m" Then
'hvis en celle i kolonne A indeholder et m farves kolonne F i samme række lysblå.
        C.Offset(0, 5).Interior.ColorIndex = 37
        C.Offset(0, 5).Font.ColorIndex = 1
Else
'hvis en celle i kolonne A er tom, vil cellerne i kolonne F i samme række, være uden farve.
        C.Offset(0, 5).Interior.ColorIndex = 0
        C.Offset(0, 5).Font.ColorIndex = 1
    End If

Next
Range("A6").Select
‘ Arket skrivebeskyttes igen efter at koden er kørt
‘ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=True
Application.ScreenUpdating = True

End Sub







Med denne kode er den den enkelte celles indhold der bestemmer farven



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("B1:K100"), Target) Is Nothing Then
With Target
    Select Case Target.Value
        Case 0
        .Interior.ColorIndex = 0
        Case 1
        .Interior.ColorIndex = 1
‘ Rammefarve er også en valgmulighed
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        Case 2
        .Interior.ColorIndex = 2
        .Font.ColorIndex = 2
        Case 3
        .Interior.ColorIndex = 3
        Case 4
        .Interior.ColorIndex = 4
        Case 5
        .Interior.ColorIndex = 5
        Case 6
        .Interior.ColorIndex = 6
        Case 7
        .Interior.ColorIndex = 7
        Case 8
        .Interior.ColorIndex = 8
        Case 9
        .Interior.ColorIndex = 9
‘Tom celle, ingen farve
        Case Else
        .Interior.ColorIndex = xlNone
    End Select
End With
End If
End Sub

Det bliver et valg mellem flere smarte funktioner
-herunder kan nævnes FORSKYDNING, INDEKS, INDIREKTE, MIN/MINDSTE og MAKS/STØRSTE

Men specielt når disse funktioner kombineres får man et særdeles kraftfuldt værktøj i Excel.

Mit valg bliver en kombination af SUM og TÆL.HVIS i følgende formel som returnerer antal unikke værdier i et område, (matrix formel).

{=SUM(SAND/TÆL.HVIS(A1:B200;A1:B200&""))}

excelent->

Det gør denne også :-)

=TÆL(HVIS(FREKVENS(A1:A500;A1:A500)>0;A1:A500))

Ingen matrix her.

Og iøvrigt også denne:

=SUMPRODUKT((A1:A10<>"")/TÆL.HVIS(A1:A10;A1:A10&""))

Måske er det i virkeligheden den allerstærkeste side ved Excel - at man kan nå frem til en løsning ad mange veje.

Tak...

Tak.

Super tråd! ;-)