Category Archives: Uncategorized

Post or page can not been placed into a specific category, group, or classification

Cryptografie en het Vernam Cipher.

Nog een voorbeeld van het Vernam Cipher. Dat is een crypto algoritme waarmee je tekst kunt versleutel en ontsleutelen (encryption en decryption) d.m.v. een geheime Key/Sleutel. Dat kan met de code die hieronder staat.
Je hoeft geen tekst of Key in te voeren want die staat al in de code. Mag jezelf veranderen. Je moet wel opletten dat de tekst en de Key dezelfde lengte hebben. Hier een voorbeeld. In de code staat trouwens een andere tekst en Key.

Kopieer de onderstaande code middels Ctrl + C
Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
Druk op M om een standaard module in te voegen
Daar waar de cursor knippert voeg je de code in middels Ctrl + V
Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel
Druk op de toetscombinatie ALT + F8 om de Macro Dialoog te tonen. Dubbelklik op de macro naam XorUsage om te starten.

Option Explicit
    ' This Vernam Cipher uses the bitwise XOR operation
    ' Purpose: Encrypt and decrypt a message using the Vernam cipher with given plaintext and key, preserving spaces.
    ' Plaintext and Key(Pwd) have to be the same length
    ' Input: Plaintext and Key(Pwd) are already hardcoded in code below. Adjust if you want
    ' Output: Ciphertext in cell A2, Decrypted text in cell A3, TRUE or FALSE in cell A4.

Sub XorUsage()
    ' This Vernam Cipher uses the bitwise XOR operation
    Dim Pwd As String
    
    ' Put into A1 the text to be encrypted /decrypted
    [A1:A5].ClearContents
    
    'Plaintext and Key(Pwd) are already hardcoded in code below. Adjust if you want
    [A1].Value = UCase("DE QUERULANT BEKLAAGDE ZICH OPNIEUW OVER MIJN XYLOFOONSPEL") ' Convert to uppercase
    ' Set the password
    Pwd = UCase("UNCOPYRIGHTABLEUNCOPYRIGHTABLEUNCOPYRIGHTABLEUNCOPYRIGHTAB")   ' Convert to uppercase
    [A2].Value = Pwd
    
    If Len(Pwd) = 0 Then Exit Sub
    
    ' Put encrtypded A1 to A2
    [A4].Value = StrXor([A1].Value, Pwd)
    
    ' Put Decrypted A2 to A3
    [A5].Value = StrXor([A4].Value, Pwd)
    
    ' Compare Decrypted A3 with Original A1
    [A6].Formula = "=A1=A5"
End Sub
 
 
Function StrXor(Txt As String, Pwd As String) As String
    Dim a As Integer, b As Integer, c As Integer, i As Long, j As Long
    For i = 1 To Len(Txt)
        j = j + 1
        If j > Len(Pwd) Then j = 1
            a = Asc(Mid(Txt, i))
            If a <> 32 Then
                b = Asc(Mid(Pwd, j))
                c = a Xor b   ' <-- Encription/Decription
                c = c Xor 255 ' <-- This excludes Chr(0)
            Else
                c = 32
            End If
        StrXor = StrXor & Chr(c)
    Next
End Function

Vindt de factoren van elk getal.

in de wiskunde is het factoriseren of het ontbinden in factoren van een getal het herschrijven van dat getal in kleinere delen, die met elkaar vermenigvuldigd weer het oorspronkelijke getal opleveren. Die kleinere delen heten de factoren van het originele getal. Kun je op pen en papier doen maar het kan sneller in Excel met VBA code.

We hebben in onderstaande code 3 onderdelen verwerkt:

  • PrimeFactors (returns a formatted factorization string)
  • ListAllFactors (schrijft alle factoren op het werkblad)
  • QuickSort (sorteert de factoren van klein naar groot)
  1. Kopieer de onderstaande code middels Ctrl + C
  2. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
  3. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
  4. Druk op M om een standaard module in te voegen
  5. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
  6. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel
  7. Druk op de toetscombinatie ALT + F8 om de Macro Dialoog te tonen. Dubbelklik op de macro naam om te starten.

In [A1] zet je een getal bijvoorbeeld: 4294967295

Vervolgens kies je voor View | Macros | View macros en klik op: ListAllFactors
om de macro te starten. Eindresultaat staat op Sheet1.

Option Explicit

' ==========================================================
' Utility Module: FactorizationTools
' Provides:
'   - PrimeFactors(number): returns prime factorization as string
'   - ListAllFactors(): lists all factors of A1 into column A
'   - QuickSort(): helper to sort factor arrays efficiently
' ==========================================================

' -----------------------------
' Returns prime factorization of number as string
' Example:  360 ? "2^3 × 3^2 × 5"
' -----------------------------
Public Function PrimeFactors(ByVal number As Double) As String
    Dim factors As String
    Dim i As Double
    Dim n As Double
    Dim cnt As Long
    
    factors = ""
    n = number
    
    ' Handle factor 2
    cnt = 0
    Do While n / 2 = Int(n / 2)
        cnt = cnt + 1
        n = n / 2
    Loop
    If cnt > 0 Then
        factors = "2"
        If cnt > 1 Then factors = factors & "^" & cnt
    End If
    
    ' Trial divide by odd numbers up to sqrt(n)
    i = 3
    Do While i * i <= n
        cnt = 0
        Do While n / i = Int(n / i)
            cnt = cnt + 1
            n = n / i
        Loop
        If cnt > 0 Then
            If factors <> "" Then factors = factors & " × "
            factors = factors & i
            If cnt > 1 Then factors = factors & "^" & cnt
        End If
        i = i + 2
    Loop
    
    ' If remainder > 1 it's a prime
    If n > 1 Then
        If factors <> "" Then factors = factors & " × "
        factors = factors & n
    End If
    
    PrimeFactors = factors
End Function

' -----------------------------
' QuickSort implementation for Double arrays
' -----------------------------
Public Sub QuickSort(arr() As Double, ByVal first As Long, ByVal last As Long)
    Dim low As Long, high As Long
    Dim pivot As Double, tmp As Double
    
    low = first
    high = last
    pivot = arr((first + last) \ 2)
    
    Do While low <= high
        Do While arr(low) < pivot
            low = low + 1
        Loop
        Do While arr(high) > pivot
            high = high - 1
        Loop
        If low <= high Then
            tmp = arr(low)
            arr(low) = arr(high)
            arr(high) = tmp
            low = low + 1
            high = high - 1
        End If
    Loop
    
    If first < high Then QuickSort arr, first, high
    If low < last Then QuickSort arr, low, last
End Sub

' -----------------------------
' Lists all factors of number in A1
'   - Outputs factors in col A starting A3
'   - Shows prime factorization in B1
'   - Shows total factor count in B2
' -----------------------------
Public Sub ListAllFactors()
    Dim num As Double
    Dim i As Double
    Dim factorCount As Long
    Dim factors() As Double
    Dim sqrNum As Double
    
    ' Read number from A1
    num = Range("A1").Value
    If num < 1 Or num > 1E+15 Then
        MsgBox "Number must be between 1 and 1,000,000,000,000,000"
        Exit Sub
    End If
    
    sqrNum = Sqr(num)
    
    ' Count factors
    factorCount = 0
    For i = 1 To sqrNum
        If num / i = Int(num / i) Then
            factorCount = factorCount + 1
            If i <> num / i Then factorCount = factorCount + 1
        End If
    Next i
    
    ReDim factors(1 To factorCount)
    
    ' Store factors
    factorCount = 0
    For i = 1 To sqrNum
        If num / i = Int(num / i) Then
            factorCount = factorCount + 1
            factors(factorCount) = i
            If i <> num / i Then
                factorCount = factorCount + 1
                factors(factorCount) = num / i
            End If
        End If
    Next i
    
    ' Sort
    If factorCount > 1 Then QuickSort factors, 1, factorCount
    
    ' Output
    Range("A3:A10000").ClearContents
    For i = 1 To factorCount
        Range("A" & (i + 2)).Value = factors(i)
    Next i
    
    ' Prime factorization & summary
    Range("B1").Value = PrimeFactors(num)
    Range("B2").Value = "Total Factors: " & factorCount
End Sub

Encryptie en decryptie met Vigenère-vierkant

Hier is een kant-en-klare VBA-macro die een volledig Vigenère-vierkant in je werkmap bouwt met de cel linksboven op A1 (A1 leeg gelaten, kolomkoppen A→Z in B1 :AA1 en rijkoppen A→Z in A2 :A27 , tabel in B2 :AA27 ).

Hoe te gebruiken

  1. Klik in Excel op Alt + F11 om de VBA-editor te openen.
  2. Invoegen → Module.
  3. Plak de onderstaande code in de module.
  4. Sluit de editor en voer de macro uit CreateVigenereSquare (je kunt op de knop drukken Alt+F8 en de macro uitvoeren).
Option Explicit

Sub CreateVigenereSquare()
    Dim ws As Worksheet
    Dim i As Long, j As Long
    Dim letter As String
    
    ' Use the active sheet (or set: Set ws = ThisWorkbook.Worksheets("Sheet1"))
    Set ws = ActiveSheet
    
    Application.ScreenUpdating = False
    
    ' Clear an area big enough (A1:AA27)
    ws.Range("A1:AA27").Clear
    
    ' Put column headers A..Z in B1:AA1 and row headers A..Z in A2:A27
    For j = 0 To 25
        ws.Cells(1, j + 2).Value = Chr(65 + j)     ' B1..AA1
        ws.Cells(j + 2, 1).Value = Chr(65 + j)     ' A2..A27
    Next j
    
    ' Fill the 26x26 Vigenère table starting at B2
    For i = 0 To 25        ' row offset (0 = A)
        For j = 0 To 25    ' column offset (0 = A)
            letter = Chr(((i + j) Mod 26) + 65)
            ws.Cells(i + 2, j + 2).Value = letter
        Next j
    Next i
    
    ' Formatting: bold headers, center text, borders, autofit
    With ws.Range("A1:AA27")
        .Font.Name = "Calibri"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
    
    ws.Range("B1:AA1").Font.Bold = True
    ws.Range("A2:A27").Font.Bold = True
    
    ' Add thin borders around the square (headers + table)
    With ws.Range("A1:AA27").Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
    
    ' Make cells square-ish and readable
    ws.Range("A1:AA27").Columns.AutoFit
    Dim c As Range
    For Each c In ws.Range("A1:AA27").Columns
        c.ColumnWidth = Application.Max(3, c.ColumnWidth) ' ensure not too narrow
    Next c
    
    ' Freeze panes to keep headers visible (freeze below row1 and right of colA)
    ws.Activate
    ws.Range("B2").Select
    ActiveWindow.FreezePanes = True
    
    Application.ScreenUpdating = True
    
    MsgBox "Vigenère square created at A1 (headers in row1/colA).", vbInformation
End Sub



' === Utility functions ===
Private Function CleanText(ByVal s As String) As String
    Dim i As Long, ch As String, outStr As String
    outStr = ""
    s = UCase(s)
    For i = 1 To Len(s)
        ch = Mid(s, i, 1)
        If ch >= "A" And ch <= "Z" Then
            outStr = outStr & ch
        End If
    Next i
    CleanText = outStr
End Function

Private Function FiveBlocks(ByVal s As String) As String
    Dim i As Long, outStr As String
    outStr = ""
    For i = 1 To Len(s)
        outStr = outStr & Mid(s, i, 1)
        If i Mod 5 = 0 And i < Len(s) Then
            outStr = outStr & " "
        End If
    Next i
    FiveBlocks = outStr
End Function

' === ENCRYPT USING TABLE ===
Sub VigenereEncryptTable()
    Dim ws As Worksheet
    Dim plain As String, key As String, cipher As String
    Dim i As Long, pChar As String, kChar As String
    Dim rowNum As Long, colNum As Long
    Dim keyLen As Long
    
    Set ws = ActiveSheet
    
    plain = CleanText(ws.Range("AD1").Value)
    key = CleanText(ws.Range("AD2").Value)
    keyLen = Len(key)
    cipher = ""
    
    For i = 1 To Len(plain)
        pChar = Mid(plain, i, 1)
        kChar = Mid(key, ((i - 1) Mod keyLen) + 1, 1)
        
        ' Find row for plaintext letter (in col A, rows 2:27)
        rowNum = Application.Match(pChar, ws.Range("A2:A27"), 0) + 1  ' offset +1 because Match is relative
        
        ' Find col for key letter (in row 1, cols B:AA)
        colNum = Application.Match(kChar, ws.Range("B1:AA1"), 0) + 1
        
        ' Get intersection
        cipher = cipher & ws.Cells(rowNum, colNum).Value
    Next i
    
    ws.Range("AD3").Value = FiveBlocks(cipher)
    MsgBox "Encryption complete using Vigenère square.", vbInformation
End Sub

' === DECRYPT USING TABLE ===
Sub VigenereDecryptTable()
    Dim ws As Worksheet
    Dim cipher As String, key As String, plain As String
    Dim i As Long, cChar As String, kChar As String
    Dim colNum As Long, rowNum As Long
    Dim keyLen As Long
    Dim rng As Range, f As Variant
    
    Set ws = ActiveSheet
    
    cipher = CleanText(ws.Range("AD5").Value)
    key = CleanText(ws.Range("AD6").Value)
    keyLen = Len(key)
    plain = ""
    
    For i = 1 To Len(cipher)
        cChar = Mid(cipher, i, 1)
        kChar = Mid(key, ((i - 1) Mod keyLen) + 1, 1)
        
        ' Find col for key letter
        colNum = Application.Match(kChar, ws.Range("B1:AA1"), 0) + 1
        
        ' Look in that column (rows 2:27) for ciphertext letter
        Set rng = ws.Range(ws.Cells(2, colNum), ws.Cells(27, colNum))
        f = Application.Match(cChar, rng, 0)
        
        If IsError(f) Then
            plain = plain & "?"
        Else
            rowNum = f + 1
            ' Row header in col A
            plain = plain & ws.Cells(rowNum, 1).Value
        End If
    Next i
    
    ws.Range("AD7").Value = FiveBlocks(plain)
    MsgBox "Decryption complete using Vigenère square.", vbInformation
End Sub

Opstelling gemaakt in Excel 2016.
AD1 PlainText: THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG
AD2 Key: LANDBOUWGESCHRIFT
AD3 Ciphertext

AD5 Ciphertext
AD6 Key: LANDBOUWGESCHRIFT
AD7 PlainText: comes here automatically

Het vierkant is ingedeeld zoals hierboven beschreven (A1 leeg gelaten, kolomkoppen A→Z in B1:AA1 en rijkoppen A→Z in A2:A27, tabel in B2:AA27).
Criterium voor het versleutelen: houd er in de code rekening mee dat je de traditie volgt door alle spaties en leestekens te verwijderen, alle letters naar hoofdletters te converteren en het resultaat in blokken van 5 letters te verdelen.

Hoe het werkt het nou?

  • AD1 → Invoer plaintext ( THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG)
  • AD2 → Key: ( LANDBOUWGESCHRIFT) zonder haakjes
  • Uitvoeren: VigenereEncryptTable→ resulteert in AD3 (cijfer, blokken van 5 letters).
  • Kopieer/plak AD3 in AD5 (cijfertekst om te testen).
  • AD6 → Key: ( LANDBOUWGESCHRIFT) zonder haakjes
  • Uitvoeren → VigenereDecryptTable resultaat in AD7 (plaintext, gegroepeerd).

Het kan trouwens ook zonder het vierkant door gebruik van ASCII. De ASC() functie converteert een teken naar het bijbehorende ASCII-codenummer, terwijl de 
CHR() functie het tegenovergestelde doet: een ASCII-nummer terug converteren naar de bijbehorende tekenweergave. Bijvoorbeeld:
ASC("A") zou retourneren 65 en  CHR(65)zou retourneren "A". Maar hier gebruiken we het vierkant

Waarden optellen terwijl Id telkens verandert

Best een moeilijke klus. In de kolommen ACEG staan de Id’s van de verkopers. In de kolommen BDFH staan de verkoopcijfers. Je wil de verkoopcijfers van elke Id (verkoper) optellen. Natuurlijk is er een probleem, de Id’s en verkoopcijfers kunnen telkens veranderen.

Ten eerste voeg je onderstaande code toe:

1. Kopieer de onderstaande code middels Ctrl + C
2. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
3. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
4. Druk op M om een standaard module in te voegen
5. Daar waar de cursor knippert voeg je de code in middels Ctrl + V

Function ArrayUnion(ParamArray Arg() As Variant) As Variant
' Code: Juan Pablo González
' Spec: Aladin Akyurek
' May 4, 2003
' Ref: TinyURL.com - shorten that long URL into a tiny URL
Dim TempUnion() As Variant
Dim i As Long, Itm As Variant, Ctr As Long
    For i = LBound(Arg) To UBound(Arg)
        Arg(i) = Arg(i)
        If IsArray(Arg(i)) Then
            For Each Itm In Arg(i)
                Ctr = Ctr + 1
                ReDim Preserve TempUnion(1 To Ctr) As Variant
                TempUnion(Ctr) = Itm
            Next Itm
        Else
            Ctr = Ctr + 1
            ReDim Preserve TempUnion(1 To Ctr) As Variant
            TempUnion(Ctr) = Arg(i)
        End If
    Next i
ArrayUnion = TempUnion
End Function

Vervolgens heb je de volgende formules nodig. Eerst maak je 2 benoemde bereiken. Ga naar:
Formulas | Name manager | New
en geef de naam Ivec. Vervolgens:
In het vak Refers to zet je de volgende formule:
=ROW(INDIRECT(“1:”&COLUMNS(PNdata)))

Herhaal dit:
Naam: PNdata
Refers to:
=arrayunion(Sheet1!$A$2:$A$12;Sheet1!$C$2:$C$12;Sheet1!$E$2:$E$12;Sheet1!$G$2:$G$12)

In J1: =SUM(IF(FREQUENCY(IF(PNdata<>””;MATCH(“~”&PNdata;PNdata&””;0));Ivec);1))

Dit is een zogenaamde array formule, invoeren met: Ctrl+Shift+Enter, NIET alleen Enter. Als je dit goed hebt gedaan, plaatst Excel accolades om de formule { }. Let op: Plaats die accolades { } niet handmatig.

In J3:
=IF(ROWS($J$3:J3)<=$J$1;MIN(IF(ISNUMBER(MATCH(PNdata;$J$2:J2;0));””;PNdata));””)
Doorvoeren naar beneden.

Dit is een zogenaamde array formule, invoeren met: Ctrl+Shift+Enter, NIET alleen Enter. Als je dit goed hebt gedaan, plaatst Excel accolades om de formule { }. Let op: Plaats die accolades { } niet handmatig.

In K3: =SUMIFS(B:H;A:G;J3)
(Dit is GEEN array formule, dus gewoon invoeren met alleen Enter).
Doorvoeren naar beneden.


Credits gaan naar: 

Code: Juan Pablo González
Spec: Aladin Akyurek
Source: https://tinyurl.com/y3b9r9qg
May 4, 2003

Unieke waarden met twee criteria

De wielrenners in de Tour de France hebben weer goed hun best gedaan. Sommige renners hebben een etappe gewonnen maar andere renners hebben meer dan 1 etappe gewonnen. Welke renners zijn dat? Ze staan in kolom D. Hiervoor is een ingewikkelde formule gebruikt en die plaats je in D2:

=IFERROR(INDEX($A$2:$A$20;SMALL(IF(FREQUENCY(IF($A$2:$A$20<>””;IF($B$2:$B$20=”yes”;IF($C$2:$C$20=”yes”;MATCH($A$2:$A$20;$A$2:$A$20;0))));ROW($A$2:$A$20)-ROW(INDEX($A$2:$A$20;1;1))+1);ROW($A$2:$A$20)-ROW(INDEX($A$2:$A$20;1;1))+1);ROWS($1:1)));””)

Dit is een zogenaamde array formule, invoeren met: Ctrl+Shift+Enter, NIET alleen Enter. Als je dit goed hebt gedaan, plaatst Excel accolades om de formule { }.

Let op: Plaats die accolades { } niet handmatig.
Doorvoeren naar beneden.

Unieke lijst genereren

Indien je een unieke lijst wil genereren is dit de manier om dat te doen. De waarden staan in kolom B. Daar staan ook dubbele of zelfs drie-dubbele waarden in:

In D2 zet je de volgende formule:

=IFERROR(INDEX($B$2:$B$1000;SMALL(IF(FREQUENCY(IF($B$2:$B$1000<>””;MATCH($B$2:$B$1000;$B$2:$B$1000;0));ROW($B$2:$B$1000)-ROW(INDEX($B$2:$B$1000;1;1))+1);ROW($B$2:$B$1000)-ROW(INDEX($B$2:$B$1000;1;1))+1);ROWS($A$2:A2)));””)

Dit is een zogenaamde array formule, invoeren met: Ctrl+Shift+Enter, NIET alleen Enter. Als je dit goed hebt gedaan, plaatst Excel accolades om de formule { }.

Let op: Plaats die accolades { } niet handmatig.
Doorvoeren naar beneden.

Nog een mogelijkheid met een kortere maar minder robuuste formule:

In F2 zet je de volgende formule:
=IFERROR(INDEX($B$2:$B$1000; MATCH(0;COUNTIF($F$1:F1; $B$2:$B$1000);0));””)

Ook dit is weer een array formule, dus invoeren met: Ctrl+Shift+Enter
Doorvoeren naar beneden.

Tenslotte, in kolom H staan tekst en cijfers door elkaar. In kolom I zet je alweer een array formule:

=IFERROR(INDEX($H$2:$H$30;SMALL(IF(FREQUENCY(IF($H$2:$H$30<>””;MATCH($H$2:$H$30;$H$2:$H$30;0));ROW($H$2:$H$30)-ROW(INDEX($H$2:$H$30;1;1))+1);ROW($H$2:$H$30)-ROW(INDEX($H$2:$H$30;1;1))+1);ROWS($A$2:A2)));””)

Ook dit is weer een array formule, dus invoeren met: Ctrl+Shift+Enter
Doorvoeren naar beneden.

Bestanden in map tonen met hyperlinks

De VBA code genereert een lijst met bestanden in een map. Je kunt zelf een map (directory) kiezen waarvan je de bestanden wil zien.

Voorbeeld weergave:

Option Compare Text
Option Explicit

Function Excludes(Ext As String) As Boolean
Dim X, NumPos As Long
    'Function purpose:  To exclude listed file extensions from hyperlink listing
    
    'Enter/adjust file extensions to EXCLUDE from listing here:
    X = Array("exe", "bat", "dll", "zip")
    
    On Error Resume Next
    NumPos = Application.WorksheetFunction.Match(Ext, X, 0)
    If NumPos > 0 Then Excludes = True
    On Error GoTo 0
End Function

Sub HyperlinkFileList()
'Macro purpose:  To create a hyperlinked list of all files in a user
'specified directory, including file size and date last modified
'NOTE:  The 'TextToDisplay' property (of the Hyperlink object) was added
'in Excel 2000.  This code tests the Excel version and does not use the
'Texttodisplay property if using XL 97.

Dim fso As Object, ShellApp As Object, File As Object
Dim SubFolder As Object, Directory As String
Dim Problem As Boolean, ExcelVer As Integer

    'Turn off screen flashing
    Application.ScreenUpdating = False

    'Create objects to get a listing of all files in the directory
    Set fso = CreateObject("Scripting.FileSystemObject")

    'Prompt user to select a directory
    Do
        Problem = False
        Set ShellApp = _
            CreateObject("Shell.Application").Browseforfolder(0, _
            "Please choose a folder", 0, "c:\\")
        On Error Resume Next
        
        'Evaluate if directory is valid
        Directory = ShellApp.self.path
        Set SubFolder = fso.GetFolder(Directory).Files
        If Err.Number <> 0 Then
            If MsgBox("You did not choose a valid directory!" _
                & vbCrLf & "Would you like to try again?", _
                vbYesNoCancel, "Directory Required") <> vbYes Then _
                Exit Sub
            Problem = True
        End If
        On Error GoTo 0
    Loop Until Problem = False

    'Set up the headers on the worksheet
    With ActiveSheet
        With .Range("A1")
            .Value = "Listing of all files in:"
            .ColumnWidth = 40
            
            'If Excel 2000 or greater, add hyperlink with file name
            'displayed.  If earlier, add hyperlink with full path displayed
            
            'Using XL2000+
            If Val(Application.Version) > 8 Then
                .Parent.Hyperlinks.Add Anchor:=.Offset(0, 1), _
                    Address:=Directory, TextToDisplay:=Directory
            
            'Using XL97
            Else
                .Parent.Hyperlinks.Add Anchor:=.Offset(0, 1), _
                    Address:=Directory
            End If
        End With
        With .Range("A2")
            .Value = "File Name"
            .Interior.ColorIndex = 15
            With .Offset(0, 1)
                .ColumnWidth = 15
                .Value = "Date Modified"
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
            End With
            With .Offset(0, 2)
                .ColumnWidth = 15
                .Value = "File Size (Kb)"
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
            End With
        End With
    End With

    'Adds each file, details and hyperlinks to the list
    For Each File In SubFolder
        If Not Excludes(Right(File.path, 3)) = True Then
            With ActiveSheet
                
                'If Excel 2000 or greater, add hyperlink with file name
                'displayed.  If earlier, add hyperlink with full path displayed
                
                'Using XL2000+
                If Val(Application.Version) > 8 Then
                    .Hyperlinks.Add _
                        Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, _
                        0), Address:=File.path, _
                        TextToDisplay:=File.Name
                
                'Using XL97
                Else
                    .Hyperlinks.Add _
                        Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, _
                        0), Address:=File.path
                End If
                
                'Add date last modified, and size in KB
                With .Range("A65536").End(xlUp)
                    .Offset(0, 1) = File.datelastModified
                    With .Offset(0, 2)
                        .Value = _
                            WorksheetFunction.Round(File.Size / _
                            1024, 1)
                        .NumberFormat = "#,##0.0"
                    End With
                End With
            End With
        End If
    Next
End Sub

Totalen berekenen, 2 criteria

Een paar winkels (Kolom A) hebben goede (of slechte) zaken gedaan en je ziet de resultaten per dag (Kolommen B:G in de afbeelding. De opgave dit keer is om de totalen (Kolom F) te berekenen. Er zijn 2 criteria namelijk, bedrag >= €5000 en de datum moet liggen tussen 2-9-2016 en 5-9-2016.

Formule in H8
=SUMIFS(B8:G8;$B$7:$G$7;”>=”&DATE(2016;9;2);$B$7:$G$7;”<=”&DATE(2016;9;5);B8:G8;”>”&5000)

Doorvoeren naar beneden.

Unieke lijst genereren

Een dynamische lijst maken. Dit betekent dat, naar mate je de lijst uitbreidt en dus langer maakt, de lijst zich als het ware aanpast.

We hebben namen van landen in Kolom A. Sommige landen staan er dubbel in of zelfs driedubbel. In Kolom C willen we slechts unieke namen van landen.

Aan de slag. Zorg dat je gegevens hebt zoals in de afbeelding. Vervolgens dien je een aantal namen met daaraan gekoppeld formules te maken. Doe dat zoals hieronder beschreven:

Formulas > Name manager > New
Name: = RowVector
Refers to: =ROW(Items)-ROW(INDEX(Items;1;1))+1
Klik: OK

Formulas > Name manager > New
Name: = Items
Refers to: =Sheet1!$A$4:INDEX(Sheet1!$A$4:$A$20;Lrow)
Klik: OK

Formulas > Name manager > New
Name: = Lrow
Refers to: =MATCH(REPT(“z”;255);Sheet1!$A$4:$A$20)
Klik: OK

Tenslotte formules in de volgende cellen zetten:

Formule in C2

=SUM(IF(FREQUENCY(IF(1-(Items="");MATCH(Items;Items;0));RowVector);1))

Invoegen met Ctrl+Shift+Enter
Doorvoeren naar beneden.

Formule in C4

=IF(ROWS($C$4:C4)<=$C$2;INDEX(Items;SMALL(IF(FREQUENCY(IF(1-(Items="");MATCH(Items;Items;0));RowVector);RowVector);ROWS($C$4:C4)));"")

Invoegen met Ctrl+Shift+Enter
Doorvoeren naar beneden.