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

Lineaire diofantische vergelijking in Excel

Een lineaire diofantische vergelijking is een vergelijking in de vorm:

px + qy = z

Waarbij p, q en z gehele getallen zijn en er oplossingen gezocht worden in gehele getallen voor de variabelen x en y . Die mogen ook negatief zijn.

Deze vergelijkingen worden bestudeerd in de getaltheorie en er zijn specifieke methoden, zoals het uitgebreide Euclidische algoritme, om ze op te lossen. Een oplossing bestaat alleen als de grootst gemene deler van:
P en Q een deler is van Z.

In Excel is de formule =GCD(P;Q) en de uitkomst MOET hetzelfde zijn als de waarde Z.

Voorbeeld:
60x + 22y = 2 en:
=GCD(60;22) uitkomst is 2

Maar hoe bereken je x en y? Een opzet in Excel in onderstaande afbeelding:

We nemen bovenstaande formule, 60x + 22y = 2. Je deelt telkens de divisor door dividend. M.a.w. hoe vaak gaat de divisor in dividend?
– Helemaal boven aan begin je met dividend (60) en divisor (22).
– 22 gaat 2 keer (dat is de quotient) in 60 en de remainder is 16. Zet die getallen in de cellen C2 en D2.
– Vervolgens vul je divisor 22 bij kolom A in en de remainder 16 in kolom B.
Dat proces herhaal je telkens tot je bij 0 (nul) uitkomt. De een na laatste stap boven 0 is 2. Dat is de grootst gemene deler.
We weten nog dat =GCD(60;22) uitkomst is 2. Dat is gelijk aan de waarde 60x + 22y = 2 en die waarde 2 hebben we in onderstaande tabel berekend. Dat betekent dat we altijd een uitkomst van x en y kunnen berekenen en dat gaan we doen.

We zetten twee tabellen op:

In deze tabel zetten we de waarden in [F2] P en in [G2] Q. Tevens de uitkomst van de grootst gemene deler GCD in [J2]. En een getal k (0) in [K2]. Dat getal is nu nog niet belangrijk. Dan nu de tabel waar het echte werk gebeurt.

In rij 12 zet je de getallen 2, 1, 2, 1, 2. Merk op dat dit de getallen (de quotienten) van Kolom C zijn.
Formule in [A13] =F2 en in [A14] de formule =G2. Neem de getallen in kolom B en C (het oranje gedeelte) gewoon over. In elke berekening die je in de toekomst gaat maken volgens dit systeem zullen deze getallen altijd standaard zijn en in die cellen staan. De getallen in het groene en gele gedeelte gaan we nu berekenen:
– (D12 * C13) + B13 = 1. Die uitkomst (1) zet je in D13.
– (E12 * D13) + C13 = 1. Die uitkomst (1) zet je in E13.
Misschien zie je het patroon al:
Het blauwe getal vermenigvuldigen door één cel naar beneden te gaan en vervolgens één cel naar links. Tel daarbij op door nog één keer naar links te gaan. We gaan verder:
– (F12 * E13) + D13 = 3. Die uitkomst (3) zet je in F13.
– (G12 * F13) + E13 = 4. Die uitkomst (4) zet je in G13.
– (H12 * G13) + F13 = 11. Die uitkomst (11) zet je in F13.

Hetzelfde gaan we nu doen om de getallen in rij 14 (groene gedeelte te krijgen. Dus:
– (D12 * C14) + B14 = 2. Die uitkomst (2) zet je in D14.
– (E12 * D14) + C14 = 3. Die uitkomst (3) zet je in E14.
– (F12 * E14) + D14 = 8. Die uitkomst (8) zet je in F14.
– (G12 * F14) + E14 = 11. Die uitkomst (11) zet je in G14.
– (H12 * G14) + F14 = 30. Die uitkomst (30) zet je in F14

De uitkomst voor x en y staan ALTIJD in de één na laatste kolom (het gele gedeelte). Het zijn 4 en 11. Die één na laatste kolom geldt voor elke berekening die je ooit gaat maken. Let daar dus op.

Het enige wat je nu nog moet doen is bepalen welke van de twee waarden (4 en 11) negatief is. Daar is geen berekening voor dus dat doe je door ze gewoon in te vullen. Je komt er dan vanzelf achter. Uitkomst moet immers altijd 2 zijn. We vullen eerst 11 in
(60 * 4) + (22 * 11) =. Helaas uitkomst = 2
(60 * 4) + (22 * 11) =. Uitkomst is 2. De waarden voor x en y zijn dus 4 en 11.
Zou je geen getal negatief maken is de uitkomst 482. Dat is dus niet goed.

En dan nu . . . wat vertegenwoordigt de k in dit spel? De k vertegenwoordigt een geheel getal, een integer.
Zo’n vergelijking zoals hier getoont kan meerdere oplossingen hebben/accepteren voor x en y. Door voor k een ander getal dan 0 (nul) in te vullen kun je andere waarden voor x en y krijgen.

Je kunt nu de waarden voor x en y invullen in deze tabel en in een formule verwijzen naar deze waarden en controleren of het klopt (uitkomst moet 2 zijn).

Formules kun je in elke willekeurige cel zetten:
Voor x is de formule: =H2 + (G2/J2) * K2 oftewel: =-4 + (22/2) * 0
Voor y is de formule: =I2 (F2/J2) * K2 oftewel: =11 – (60/2) * 0
Uitkomst MOET ALTIJD 2 zijn.

Let op: In de formule voor y moet je het min-teken zetten NIET het + teken.
Merk ook op dat je bij waarde x in de formule deelt door G2 (G2/J2) en in de formule voor waarde y deel je door F2 (F2/J2)

Nu kun je voor k een ander getal invullen bijvoorbeeld 8. Dan krijgen x en y automatisch de waarden van: 84 en -229. y wordt dus negatief en de uitkomst zal weer 2 zijn. Je kunt zelf een negatief getal invullen voor k.

.

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

Handtekening in Excel op factuur

Je wilt je handtekening op een Excel werkblad zetten waarop bijvoorbeeld een factuur staat. Dit is je handtekening.

En dit is je werkblad in Excel:

Go to Pictures | Insert Picture from | This Device | From File
en kies je handtekening.

Pas de grootte van de handtekening aan.

Vervolgens kies je in de menubalk voor Picture Format en dan:
Colour | Set transparent colour (Staat onderaan): En klik in het witte gedeelte (de achtergrond). Je kunt je handtekening ook nog van een andere kleur voorzien.

Klaar.

Je kunt natuurlijk ook online gaan en de achtergrond van je handtekening transparant maken
Of hier: https://www.remove.bg/ Je kunt de handtekening ook in een Word bestand invoegen of in een PDF bestand.

Eenvoudig voorbeeld SUMPRODUCT

Anders dan de naam doet vermoeden gaan we bij het gebruik van SUMPRODUCT eerst vermenigvuldigen en dan pas optellen. Hieronder vind je een lijst met films uit 2018 en wat bijzonderheden in de diverse kolommen. We willen a.d.h.v. een aantal criteria de juiste resultaten filteren en de bruto inkomsten berekenen. Criteria zijn:
– De distributor is 20th Century Fox
– Genre is Action
– TicketsSold is meer dan 30.000.000 (30 miljoen)

In het bereik B15:B17 plaatsen we de criteria en in B19 komt de formule.

Formule:

In [B19] =SUMPRODUCT(($C$3:$C$12=$B$15)*($D$3:$D$12=$B$16)*($F$3:$F$12>$B$17)*$E$3:$E$12)

Dit resulteert in een reeks TRUE en FALSE:

{FALSE;FALSE;FALSE;FALSE;TRUE;FALSE;FALSE;FALSE;FALSE;FALSE}
{TRUE;TRUE;FALSE;TRUE;TRUE;FALSE;FALSE;TRUE;TRUE;FALSE}
{TRUE;TRUE;TRUE;TRUE;TRUE;FALSE;FALSE;FALSE;FALSE;FALSE}

zoals je weet resulteert:
TRUE in 1
en
FALSE in 0

En dan krijg je:
{0;0;0;0;1;0;0;0;0;0}
{1;1;0;1;1;0;0;1;1;0}
{1;1;1;1;1;0;0;0;0;0}

Dan gaan we vermenigvuldigen. Je ziet dat er maar 1 combinatie is met drie enen (1*1*1) = 1 (rode gedeelte) en die correspondeert met de 5e waarde namelijk 324512774 en dat is tegelijk het eindresultaat omdat we geen verdere waarden hoeven op te tellen.

{700059566;678815482;608581744;417719760;324512774;269622130;235506359;220159104;216648740;213767512}

Verander je de Distributor in Walt Disney dan krijg je:
{1;1;0;0;0;0;0;0;1;1}
{1;1;0;1;1;0;0;1;1;0}
{1;1;1;1;1;0;0;0;0;0}

We gaan weer eerst vermenigvuldigen. Je ziet dat er nu 2 combinatie zijn met drie enen (1*1*1) = 1 (rode gedeelte) en die corresponderen met de 1e waarde en 2e waarde. Die tellen we op en krijgen als resultaat 1.378.875.048

{700059566;678815482;608581744;417719760;324512774;269622130;235506359;220159104;216648740;213767512}

Hoe plaats je een verwijzing naar een bibliotheek

Als je met Visual Basic for Applications werkt, kun je verwijzingen instellen naar andere, zogenaamde, bibliotheken. Dit zijn geen boeken maar een soort van kleine programma’s. Indien je nog niet in de Visual Basic Editor bent, druk je op Alt+F11.
Vervolgens op Tools | References. Je krijgt dan een menu waarin je talloze bibliotheken ziet zoals:

– Microsoft Scripting Runtime
– Microsoft Internet Controls
– Microsoft HTML Object Library
– Microsoft XLM, v6.0

Hoe vaak komt dat woord voor?

Hoe vaak komt een woord voor in een tekst? Ik zou niet weten waarom je dat zou willen weten. Maar met Excel kun je zoiets berekenen.
In afbeelding 1 zie je in Cel A1 en A2 een paar zinnen uit de welbekende  Lorem Ipsum tekst.

AFBEELDING 1

In Afbeelding 2 zie je een gedeelte van het resultaat.

AFBEELDING 2

De VBA code die je kunt gebruiken.
LET OP, de eerste code is hoofdletter gevoelig. Dat betekent dat bijvoorbeeld het woord “nulla” anders is als het woord “Nulla”. Beide woorden komen daarom 2x voor.

Option Explicit

Sub Hoe_Vaak_Komt_Dat_Woord_Voor()
'Zet Data in meerdere cellen van Kolom A.
'Data alleen in A1 geeft foutmelding
'Data in Kolom A, resultaat komt in de Kolommen C:D.

Dim x As Long, Cnt As Long, Txt As String, Arr() As String
    Txt = " " & Join(Application.Transpose(Range([A1], Cells(Rows.Count, "A").End(xlUp)))) & " "
    
    For x = 2 To Len(Txt)
        If Mid(Txt, x, 1) = "'" And Not Mid(Txt, x - 1, 3) Like "[A-Za-z0-9]'[A-Za-z0-9]" Then
            Mid(Txt, x) = " "
        ElseIf Mid(Txt, x, 1) Like "[!A-Za-z0-9']" Then
            Mid(Txt, x) = " "
        End If
    Next
    
    Arr = Split(Application.Trim(Txt))
    
    With CreateObject("scripting.dictionary")
        
        For x = 0 To UBound(Arr)
            .Item(Arr(x)) = .Item(Arr(x)) + 1
        Next
        
        Cnt = .Count
        Range("C2").Resize(Cnt) = Application.Transpose(.Keys)
        Range("D2").Resize(Cnt) = Application.Transpose(.items)
    End With
    
    Range("C2:D" & Cnt).Sort Range("C2"), xlAscending, Range("D2"), , xlDescending, Header:=xlNo, MatchCase:=False
End Sub

LET OP, de tweede code is NIET hoofdletter gevoelig. Dat betekent dat bijvoorbeeld het woord “nulla” hetzelfde is als het woord “Nulla” en daarom 4x voor komt.

Sub Hoe_Vaak_Komt_Dat_Woord_Voor_Met_RegExp()
'Data in Kolom A, resultaat komt in de Kolommen F:G.
'*****************************************************
'Geef een verwijzing op naar:
'Microsoft Forms 2.0 Object Library
'Te bereiken via: Alt+F11 | Tools | References
'*****************************************************

Dim regEx As Object, matches As Object, x As Object, d As Object
Dim obj As New DataObject
Dim tx As String, z As String

    Range("A1", Cells(Rows.Count, "A").End(xlUp)).Copy
    obj.GetFromClipboard
    tx = obj.GetText
    Application.CutCopyMode = False
    tx = Replace(tx, "'", "___")
        
    Set regEx = CreateObject("VBScript.RegExp")
    
    With regEx
        .Global = True
        .MultiLine = True
        .IgnoreCase = True
        .Pattern = "\w+"
    End With
    
    Set d = CreateObject("scripting.dictionary")
    d.CompareMode = vbTextCompare
        
    Set matches = regEx.Execute(tx)
            
        For Each x In matches
            z = CStr(x)
            If Not d.Exists(z) Then
                d(z) = 1
            Else
                d(z) = d(z) + 1
            End If
        Next
                    
    If d.Count = 0 Then MsgBox "Nothing found": Exit Sub
    Range("D:E").ClearContents
    
    'put the result in col D:E
        With Range("F2").Resize(d.Count, 2)
            .Cells = Application.Transpose(Array(d.Keys, d.items))
            .Replace What:="___", Replacement:="'", LookAt:=xlPart, SearchFormat:=False, ReplaceFormat:=False
        End With
    'Sort
    Range("F2:G" & d.Count).Sort Range("F2"), xlAscending, Range("G2"), , xlDescending, Header:=xlNo, MatchCase:=False
End Sub

Vind de hoogste waarde van een bedrijf

In Kolom A staan bedrijven. Sommige bedrijven staan er meerdere keren in. We hebben dus te maken met dubbele waarden in kolom A

We willen in dit voorbeeld de HOOGSTE waarde van Hasbro, Inc.
In D2 kun je een validatielijst maken met alle namen van de bedrijven zodat je gemakkelijk een bedrijf kunt selecteren.

Om dat te doen maak je ergens op je werkblad eerst een unieke lijst met alle bedrijven, Bijvoorbeeld in F2:F14.

Data | Data validation | Data validation | Allow > List | Source > en verwijs naar F2:F14

In [D5] =MAX(INDEX((A2:A21=D2)*B2:B21;0))