We hebben een tabel zoals in de afbeelding hieronder. Het doel is om dezelfde producten op te tellen en te vermenigvuldigen. Bijvoorbeeld: het aantal fusten “Rhönbräu Klosterbier” maal het aantal items (in dit geval liters, omdat de eenheid voor fusten liters is). In totaal hebben we 48 fusten “Rhönbräu Klosterbier”. Een deel van de fusten bevat 15 liter en een ander deel 12 liter. Dit komt samen uit op een totaal van 648 liter “Rhönbräu Klosterbier”.
Formule in G2 is: =SUMPRODUCT(--(A$2:A$11=F2);B$2:B$11;D$2:D$11) Doorvoeren naar beneden.
On Sheet1 the names of sellers are in Column C and in Column D are amounts. In Column C, the name of the same employee can appear multiple times.
On Sheet2, we want to show the seller with the highest total amount and then the second seller, etc. A kind of Top 10 so to speak. In addition, there is a criterion, we only count the amounts for which column E says “Sold”.
Sheet1
Sheet2
A1 Since you want to see a Top-N, enter the number here, for example 8. Then you get to see the Top-8.
You have to enter the formulas with Ctrl+Shift+Enter (not just Enter)
In $A$3:$A$93 namen waaronder veel dubbele namen, We willen in C3 een lijst met unieke namen en die lijst sorteren van A naar Z. Niet al te moeilijk. We hebben slechts één formule nodig.
In [C3] =IFERROR(INDEX($A$3:$A$93; MATCH(SMALL(IF(COUNTIF($C$2:C2; $A$3:$A$93)=0; COUNTIF($A$3:$A$93; "<"&$A$3:$A$93); ""); 1); COUNTIF($A$3:$A$93; "<"&$A$3:$A$93); 0));"")
Invoeren met Ctrl+Shift+Enter (NIET alleen Enter)
En doorvoeren naar beneden.
Bijvoorbeeld in A1:
=ExtendedEuclideanWithSteps(1190;672;33;11;TRUE)
Function ExtendedEuclideanWithSteps(a As Long, b As Long, ByRef x As Long, ByRef y As Long, Optional showSteps As Boolean = False) As Long
' Extended Euclidean Algorithm with step-by-step explanation
Dim temp As Long
Dim x1 As Long, x2 As Long, y1 As Long, y2 As Long
Dim q As Long, r As Long
Dim stepCount As Integer
Dim result As String
Dim originalA As Long, originalB As Long
' Store original values
originalA = a
originalB = b
' Ensure positive numbers
a = Abs(a)
b = Abs(b)
' Handle zero cases
If a = 0 And b = 0 Then
x = 0: y = 0
ExtendedEuclideanWithSteps = 0
Exit Function
End If
If a = 0 Then
x = 0: y = Sgn(b)
ExtendedEuclideanWithSteps = b
Exit Function
End If
If b = 0 Then
x = Sgn(a): y = 0
ExtendedEuclideanWithSteps = a
Exit Function
End If
' Initialize coefficients and step counter
x1 = 1: x2 = 0
y1 = 0: y2 = 1
stepCount = 0
If showSteps Then
result = "Extended Euclidean Algorithm Steps:" & vbCrLf & vbCrLf
result = result & "Find GCD(" & originalA & ", " & originalB & ") and coefficients x, y" & vbCrLf
result = result & "such that: " & originalA & "x + " & originalB & "y = GCD" & vbCrLf & vbCrLf
result = result & "Step " & stepCount & ":" & vbCrLf
result = result & "a = " & a & ", b = " & b & vbCrLf
result = result & "x1 = " & x1 & ", x2 = " & x2 & vbCrLf
result = result & "y1 = " & y1 & ", y2 = " & y2 & vbCrLf & vbCrLf
End If
' Extended Euclidean Algorithm
Do While b <> 0
stepCount = stepCount + 1
q = a \ b
r = a Mod b
If showSteps Then
result = result & "Step " & stepCount & ":" & vbCrLf
result = result & a & " = " & b & " * " & q & " + " & r & vbCrLf
End If
' Update coefficients
temp = x2
x2 = x1 - q * x2
x1 = temp
temp = y2
y2 = y1 - q * y2
y1 = temp
If showSteps Then
result = result & "New coefficients: x1 = " & x1 & ", x2 = " & x2 & vbCrLf
result = result & " y1 = " & y1 & ", y2 = " & y2 & vbCrLf & vbCrLf
End If
' Update a and b
a = b
b = r
Loop
' Set results
x = x1
y = y1
ExtendedEuclideanWithSteps = a
If showSteps Then
result = result & "Final Result:" & vbCrLf
result = result & "GCD(" & originalA & ", " & originalB & ") = " & a & vbCrLf
result = result & "Coefficients: x = " & x & ", y = " & y & vbCrLf
result = result & "Verification: " & originalA & "*" & x & " + " & originalB & "*" & y & " = "
result = result & (originalA * x + originalB * y) & " = " & a
MsgBox result
End If
End Function
Er zijn twee vergelijkingen op te lossen. We noemen dat een verzameling van twee of meer vergelijkingen die dezelfde variabelen gebruiken (x en y). De oplossing van die twee vergelijkingen is de combinatie van x en y die aan de 2 vergelijkingen tegelijk moeten voldoen.
De 2 vergelijkingen:
2x + 3y = 21 5x + 2y = 3
Vul de waarden van de coëfficienten in: In [B8] 2 In [C8] 3 In [B9] 5 In [C9] 2
Selecteer het bereik B11:C12
En vul formule in: =MINVERSE(B8:C9). Doe dat met Ctrl+Shift+Enter
Selecteer het bereik F11:F12
En vul de formule in: =MMULT(B11:C12;E8:E9). Doe dat met Ctrl+Shift+Enter
Het Vernam Cipher/cijfer (ook wel het “One-Time-Pad”) genoemd is het éénmalig blokcipher of het perfecte cipher genoemd, is een crypto algoritme waarbij men de tekst of data combineert met een willekeurige Sleutel/Key van dezelfde lengte. Het is de enige gekende vercijfering die onbreekbaar is.
Gebruikt door Special Operations teams en het verzet in Wereldoorlog II, populair bij inlichtingendiensten en hun spionnen sinds de Koude Oorlog en decennialang ten dienste van de diplomatie en het leger heeft het Vernam Cipher een sterke reputatie opgebouwd als eenvoudige maar onbreekbare encryptie met een absolute veiligheid die ongeëvenaard is door moderne crypto algoritmes.
Om van Vernam Cipher encryptie te kunnen spreken en de onbreekbaarheid effectief te verwezenlijken dient aan verschillende voorwaarden voldaan te zijn. Indien één van deze voorwaarden ontbreekt kan men niet meer spreken van het Vernam Cipher/One-Time-Pad en is het niet meer onbreekbaar. Bij correct gebruik is Vernam Cipher/One-Time-Pad echter de enige bestaande bewezen perfect veilige vercijfering, bestand tegen elke mogelijke cryptoanalytische aanval. Dit werd bewezen in Claude Shannon’s verhandeling ‘Communication theory of secrecy systems’.
De criteria voor een echte Vernam Cipher: – De sleutel moet op een volstrekt willekeurige manier zijn gegenereerd. – De sleutel moet dezelfde lengte als de platte tekst hebben. – De sleutel mag slechts één keer gebruikt worden. – Na één keer gebruik moet de sleutel vernietigd worden. – Van een sleutel mogen slechts twee kopieën bestaan, een voor de verzender en een voor de ontvanger van de gegevens.
Door aan deze criteria te voldoen, wordt de resulterende versleutelde tekst statistisch, willekeurig en theoretisch onkraakbaar. Hierdoor is frequentieanalyse onmogelijk en is ontcijfering onmogelijk zonder de juiste sleutel.
De Code is ONKRAAKBAAR omdat het berust op een willekeurig gegenereerd getal. Zelfs met de allergrootste huidige supercomputers is de code niet te kraken MITS alle voorwaarden correct worden nageleefd.
In [B1] zet je de plaintext. Als voorbeeld hebben we de volgende tekst gebruikt: THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG In [B2] =GenerateKey(LEN(B1)) In [B3] =EncryptTextUDF(B1; B2) In [B4] =DecryptTextUDF(B3;B2)
En dan de VBA code:
Option Explicit
' =========================================================
' Vernam Cipher (XOR-based) with Hex Encoding for Excel
' =========================================================
' Generate a random key of the same length as the plaintext (A–Z)
Function GenerateKey(plaintextLength As Long) As String
Dim i As Long
Dim key As String
Randomize
For i = 1 To plaintextLength
key = key & Chr(Int(Rnd * 26) + 65)
Next i
GenerateKey = key
End Function
' Encrypt plaintext using XOR, return readable hex string
Function EncryptText(plaintext As String, key As String) As String
Dim i As Long
Dim pChar As Integer, kChar As Integer, cChar As Integer
Dim cipherHex As String
If Len(key) < Len(plaintext) Then
EncryptText = "#KEY TOO SHORT#"
Exit Function
End If
For i = 1 To Len(plaintext)
pChar = Asc(Mid(plaintext, i, 1))
kChar = Asc(Mid(key, i, 1))
cChar = pChar Xor kChar
cipherHex = cipherHex & Right("0" & Hex(cChar), 2)
Next i
EncryptText = cipherHex
End Function
' Convert hex string to raw binary string
Private Function HexToString(hexStr As String) As String
Dim i As Long
Dim result As String
Dim val As Long
hexStr = Replace(hexStr, " ", "")
If Len(hexStr) Mod 2 <> 0 Then
HexToString = ""
Exit Function
End If
For i = 1 To Len(hexStr) Step 2
val = CLng("&H" & Mid(hexStr, i, 2))
result = result & Chr(val)
Next i
HexToString = result
End Function
' Decrypt hex ciphertext using XOR with key
Function DecryptText(cipherHex As String, key As String) As String
Dim i As Long
Dim plaintext As String
Dim cChar As Integer, kChar As Integer, pChar As Integer
Dim cipherRaw As String
cipherRaw = HexToString(cipherHex)
If Len(key) < Len(cipherRaw) Then
DecryptText = "#KEY TOO SHORT#"
Exit Function
End If
For i = 1 To Len(cipherRaw)
cChar = Asc(Mid(cipherRaw, i, 1))
kChar = Asc(Mid(key, i, 1))
pChar = cChar Xor kChar
plaintext = plaintext & Chr(pChar)
Next i
DecryptText = plaintext
End Function
' =========================================================
' Worksheet-Friendly UDFs
' =========================================================
' Manual key versions (for static use)
Function EncryptTextUDF(plaintext As String, key As String) As String
EncryptTextUDF = EncryptText(plaintext, key)
End Function
Function DecryptTextUDF(cipherHex As String, key As String) As String
DecryptTextUDF = DecryptText(cipherHex, key)
End Function
' =========================================================
' Auto-Key Paired Functions (for use in adjacent cells)
' =========================================================
' Generates and stores a random key (updates each recalc)
Function EncryptAutoKey_Key(plaintext As String) As String
Dim gAutoKey As String
gAutoKey = GenerateKey(Len(plaintext))
EncryptAutoKey_Key = gAutoKey
End Function
' Uses the most recently generated key for the same recalc cycle
Function EncryptAutoKey_Cipher(plaintext As String) As String
Dim gAutoKey As String
If gAutoKey = "" Then
' fallback: if used standalone, generate a key automatically
gAutoKey = GenerateKey(Len(plaintext))
End If
EncryptAutoKey_Cipher = EncryptText(plaintext, gAutoKey)
End Function
' =========================================================
' Quick Test (Immediate Window)
' =========================================================
Sub TestVernamCipher()
Dim plaintext As String, key As String, cipherHex As String, decrypted As String
plaintext = "HELLO"
key = GenerateKey(Len(plaintext))
Debug.Print "Plaintext: " & plaintext
Debug.Print "Key: " & key
cipherHex = EncryptText(plaintext, key)
Debug.Print "Ciphertext (Hex): " & cipherHex
decrypted = DecryptText(cipherHex, key)
Debug.Print "Decrypted Text: " & decrypted
End Sub
Je kunt de code vanuit de VBA IDE bereiken via sneltoets Alt-F11 en dan Sub TestVernamCipher starten middels F5.
Belangrijk: Je kunt het beste geen computer gebruiken om de Key/Sleutel voor een Vernam Cipher te genereren, omdat een door de computer gegenereerde Key niet echt willekeurige cijfers of letters kan genereren. waardoor deze kwetsbaar is voor cryptoanalyse Om de perfecte geheimhouding van het Vernam Cipher te bereiken, moet de sleutel echt willekeurig zijn, dezelfde lengte hebben als het bericht, slechts één keer worden gebruikt en veilig worden gedeeld tussen de verzender en de ontvanger.
Een computer maakt doorgaans gebruik van PRNG, een deterministisch algoritme dat een reeks getallen produceert die willekeurig lijkt, maar in werkelijkheid voorspelbaar is als de beginwaarde en het algoritme bekend zijn.
Je kunt de Microsoft HTML Object Library gebruiken om een lokaal HTML-bestand te parseren zonder Internet Explorer te gebruiken. Wat betekent dat? Je kunt een lokaal HTML-bestand openen met een webbrowser om het weer te geven of een teksteditor (Kladblok) om de HTML-code te bekijken, aan te passen of om er specifieke data uit te halen. Dat wordt ook wel webscraping genoemd. Bijvoorbeeld prijzen ophalen.
Iedereen die wel eens webscraping heeft gedaan, deed dat door op de achtergrond Internet Explorer te starten om naar een webadres te navigeren. Zodra de pagina klaar is, begint het navigeren door de zogenaamde DOM. Met de term DOM (Document Object Model) HTML wordt bedoeld dat de HTML-code van een webpagina omgezet wordt in een boomstructuur van objecten met behulp van de ‘Microsoft HTML Object Library’ (MSHTML). Maar wat te doen als IE niet beschikbaar is?
Je hebt een lokaal bestand nodig om mee te werken en een verwijzing naar de ‘Microsoft HTML Object Library’ te bereiken via: Alt+F11 | Tools | References Alt+F11 | Extra | Verwijzingen
We noemen het lokaal bestand: The_Local_File.html. Dat staat al hard-coded in de code. Het wordt automatisch aangemaakt. Vervolgens navigeren we naar: “https://www.theguardian.com/europe” en slaan de complete pagina op in The_Local_File.html. Tenslotte halen we alle koppen op en drukken die af in het immediate venster (Direct venster) in VBA IDE (te bereiken via Alt+F11)
Option Explicit
'* Tools -> References Microsoft HTML Object Library
'* MSDN - URLDownloadToFile function - https://msdn.microsoft.com/en-us/library/ms775123(v=vs.85).aspx
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" _
(ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Sub Test()
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim sLocalFilename As String
'The local file. You don't need to create it. Its created on the fly.
sLocalFilename = Environ$("TMP") & "\The_Local_File.html"
Dim sURL As String
'Navigate to
sURL = "https://www.theguardian.com/europe"
Dim bOk As Boolean
bOk = (URLDownloadToFile(0, sURL, sLocalFilename, 0, 0) = 0)
If bOk Then
If fso.FileExists(sLocalFilename) Then
'* Tools -> References Microsoft HTML Object Library
Dim oHtml4 As MSHTML.IHTMLDocument4
Set oHtml4 = New MSHTML.HTMLDocument
Dim oHtml As MSHTML.HTMLDocument
Set oHtml = Nothing
'* IHTMLDocument4.createDocumentFromUrl
'* MSDN - IHTMLDocument4 createDocumentFromUrl method
'- https://msdn.microsoft.com/en-us/library/aa752523(v=vs.85).aspx
Set oHtml = oHtml4.createDocumentFromUrl(sLocalFilename, "")
'* need to wait a little whilst the document parses
'* because it is multithreaded
While oHtml.readyState <> "complete"
'* do not comment this out it is required to break into the code if in infinite loop
DoEvents
Wend
Debug.Assert oHtml.readyState = "complete"
Dim sTest As String
sTest = Left$(oHtml.body.outerHTML, 100)
'* just testing we got a substantial block of text, feel free to delete
Debug.Assert Len(Trim(sTest)) > 50
'* this is where the page information goes
Dim htmlAnswers As Object 'MSHTML.DispHTMLElementCollection
Set htmlAnswers = oHtml.getElementsByClassName("show-underline")
Dim lAnswerLoop As Long
For lAnswerLoop = 0 To htmlAnswers.Length - 1
Dim vAnswerLoop
Set vAnswerLoop = htmlAnswers.Item(lAnswerLoop)
Debug.Print vAnswerLoop.outerText
Next
End If
End If
End Sub
