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
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)
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 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
Kolom A, de te bewerken data Formule: In B1 =TRIM(LEFT(A2;SEARCH(“(“;A2&”(“)-1)) Invoeren met Enter en doorhalen naar beneden.
Tenslotte, selecter de data in kolom B en vervolgens “Text to Columns” en in de volgende vensters kiezen voor space als delimiter. Resultaat in kolom C en D.
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.
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.
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
Klik in Excel op Alt + F11 om de VBA-editor te openen.
Invoegen → Module.
Plak de onderstaande code in de module.
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
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.
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)
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.
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
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 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
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
