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.
Best een moeilijke klus. In de kolommen A, C, E, G staan de Id’s van de verkopers. In de kolommen B, D, F, H 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
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:
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.
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:
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:
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
