Monthly Archives: September 2025

Optellen alle aankopen van één klant

9 September 2025Uncategorizedadmin

Klant BERGS heeft diverse producten gekocht. We willen het totaal berekenen door van al zijn gekochte producten het subtotaal (Kolom E) op te tellen.

Formule in G5.
=SUMPRODUCT(($A$2:$A$10=$G$2)*($E$2:$E$10))

In G2 kun je een validatielijst maken met alle namen van de klanten.

Gegevens | Gegevensvalidatie | Gegevensvalidatie | Toestaan > Lijst | Bron > (type in het vak ->) ALFKI;BERGS;FAMIA
Let op de puntkomma tussen de klantnamen.

Unieke lijst maken en één product uitsluiten

9 September 2025Uncategorizedadmin

Je hebt een lijst waarin dubbele waarden voorkomen. Je wilt een lijst maken met unieke waarden maar één waarde wil je uitsluiten/negeren.

Formule C7
=IFERROR(INDEX($A$7:$A$28;SMALL(IF(FREQUENCY(IF($A$7:$A$28<>””;IF(1-ISNUMBER(SEARCH($B$4;$A$7:$A$28));MATCH($A$7:$A$28;$A$7:$A$28;0)));ROW($A$7:$A$28)-ROW($A$7)+1);ROW($A$7:$A$28)-ROW($A$7)+1);ROWS(C$7:C7)));””)

Let op: Invoeren met: Ctrl+Shift+Enter

Formule B3
=SUM(IF(FREQUENCY(IF($A$7:$A$28<>””;IF(1-ISNUMBER(SEARCH($B$4;$A$7:$A$28));MATCH($A$7:$A$28;$A$7:$A$28;0)));ROW($A$7:$A$28)-ROW($A$7)+1);1))

Let op: Invoeren met: Ctrl+Shift+Enter

2 lijsten vergelijken

9 September 2025Uncategorizedadmin

Je kent dat wel. Je hebt twee lijsten die gegevens bevatten. Nu wil je checken of de items in Lijst_2 voorkomen in Lijst_1. Als het lange lijsten zijn is dat een hels karwei. Bijvoorbeeld, komt “Drachenblut Delikatessen” voor in Lijst_1? Ja (TRUE). Komt “QUICK-Stop” voor in Lijst_1? Nee (FALSE).

Formule die je daarvoor kan gebruiken is simpel:
D1 =ISNUMBER(MATCH($B2;$A$2:$A$11;0))
Doorvoeren naar beneden.

Wil je weten of een item NIET in Lijst_1 voorkomt dan gebruik je de formule:
E1 =ISNA(MATCH($B2;$A$2:$A$11;0))
Doorvoeren naar beneden.

Scrape complete webpagina

9 September 2025Uncategorizedadmin

Nog een voorbeeld van ‘webscraping’ om de online voorpagina van The Guardian van het web te halen. Het resultaat wordt geschreven naar het bestand:
C:\temp\textfile.html
Zorg dat je de map C:\temp maakt. Het bestand textfile.html wordt automatisch gemaakt als het nog niet aanwezig/gemaakt is.
Webscraping is het geautomatiseerd gegevens verzamelen van webpagina’s

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 scrape_complete_webpage()

    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim sLocalFilename As String
    sLocalFilename = Environ$("TMP") & "\urlmon.html"
    
    Dim sURL As String
    
    sURL = "https://www.theguardian.com/europe"
    'sURL = "https://www.theguardian.com/artanddesign/gallery/2015/sep/25/inside-un-headquarters-in-pictures"
    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"
                DoEvents  'do not comment this out it is required to break into the code if in infinite loop
            Wend
            Debug.Assert oHtml.readyState = "complete"
            

            Dim sTest As String
            sTest = Left$(oHtml.body.outerHTML, 100)
            Debug.Assert Len(Trim(sTest)) > 50  'just testing we got a substantial block of text, feel free to delete
            
            ' Get elements by class name
            Dim elems, i
            Set elems = oHtml.getElementsByClassName("top-fronts-banner-ad-container dcr-12mgsnl")
            
            ' Loop through elements and remove them
            For i = elems.Length - 1 To 0 Step -1
                elems.Item(i).ParentNode.RemoveChild elems.Item(i)
            Next i
            
            LogInformation (oHtml.body.outerHTML)
        End If
    End If
End Sub

Sub LogInformation(LogMessage As String)
Dim fileNum As Integer, x1 As String, x2 As String
Const LogFileName As String = "C:\temp\textfile.html"
    
    Open "C:\temp\textfile.html" For Output As #1: Close #1
    'MsgBox "Clear complete"

    fileNum = FreeFile ' next file number
    Open LogFileName For Append As #fileNum ' creates the file if it doesn't exist
    
    'remove everything between <header data-component="header"> and </header> including these two tags
    x1 = Split(LogMessage, "<div id=""bannerandheader"" data-print-layout=""hide"">")(0) ' the text before <div id="bannerandheader" data-print-layout="hide">
    x2 = Split(LogMessage, "</header>")(1) ' the text after </header>
    LogMessage = x1 & x2

    LogMessage = Replace(LogMessage, Range("A5"), Range("A6"))
    Print #fileNum, LogMessage ' write information at the end of the text file
    Close #fileNum ' close the file
End Sub

Scrape game data van website

9 September 2025Uncategorizedadmin

Er zijn veel mogelijkheden om gegevens van een website te halen (ook wel webscraping genoemd). Dit is een van de voorbeelden.

Sub ScrapeGameData()
'set reference to the Microsoft HTML Object Library
    Dim ie As Object ' Internet Explorer instance
    Dim doc As Object ' HTML Document
    Dim platformLinks As Object, titles As Object, prices As Object
    Dim i As Integer
    
    ' Create a new Internet Explorer instance
    Set ie = CreateObject("InternetExplorer.Application")
    
    ' Navigate to the webpage
    ie.Visible = False
    ie.navigate "https://www.gameshop.nl/webshop/index.php" ' Change to the correct URL
    
    ' Wait for the page to load
    Do While ie.Busy Or ie.readyState <> 4
        DoEvents
    Loop
    
    ' Get the document
    Set doc = ie.document
    
    ' Get elements by class name
    Set platformLinks = doc.getElementsByClassName("platform-link")
    Set titles = doc.getElementsByClassName("titel")
    Set prices = doc.getElementsByClassName("prijs")
    
    ' Output results to Immediate Window (Ctrl+G in VBA editor to view)
    For i = 0 To platformLinks.Length - 1
        Debug.Print "Platform: " & platformLinks.Item(i).innerText
        Debug.Print "Title: " & titles.Item(i).innerText
        Debug.Print "Price: " & prices.Item(i).innerText
        Debug.Print "----------------------------"
    Next i

    ' Clean up
    ie.Quit
    Set ie = Nothing
    Set doc = Nothing
End Sub

Gegroepeerde gegevens optellen gebaseerd op 5 criteria

9 September 2025Uncategorizedadmin

Indien je de bedragen in Kolom F (Amount) wil optellen gebaseerd op de 5 criteria in kolommen A:E (First – Last – Company – Year – Month), heb je wat formules nodig. Vanwege het overzicht zijn de gegevens al gegroepeerd weergegeven. Bekijk bijvoorbeeld de gegevens in Rij 2 en 3. Die zijn hetzelfde namelijk:

Andrew Fuller Tokyo Traders 2015 11
Andrew Fuller Tokyo Traders 2015 11

De twee bedragen bij elkaar opgeteld € 15,67 + € 6,19 = € 21,86
En dat record zie je staan in Rij 2 in de Kolommen H:M

Stel je voor dat de records in Kolommen A:F door elkaar staan en dat het om honderden records gaat, je kunt je dan voorstellen dat het een hele klus is om eerst alles te sorteren en vervolgens de bedragen die bij de passende records horen op te tellen. Door enkele formules in de kolommen H:M te plaatsen.

Samengevat: Tel de bedragen in Kolom F op voor elke unieke combinatie in de Rijen A:E.

Dan nu de formules. Je moet natuurlijk eerst gegevens hebben zoals hierboven. Vervolgens maak je een paar benoemde bereiken. Doe dat als volgt:

– Ga met de cursor in je tabel staan.
– Druk op Ctrl+Shift+F3 Je komt bij: Create names from selection.
– Check > Top row
– En dan OK.

Je hebt nu 5 benoemde bereiken namelijk:

First =Sheet2!$A$2:$A$45
Last =Sheet2!$B$2:$B$45
Company =Sheet2!$C$2:$C$45
Year =Sheet2!$D$2:$D$45
Month =Sheet2!$E$2:$E$45

Let op dat de formule naar Sheet2! verwijst.

Vervolgens, ga naar Formulas > Name manager > New. Vul in:
Name: RowVector
Refers to: =ROW(First)-ROW(INDEX(First;1;1))+1

Onderstaande formules invoeren met Ctrl+Shift+Enter

H2 =IFERROR(INDEX(First;SMALL(IF(FREQUENCY(IF(First<>"";MATCH(First&"|"&Last&"|"&Company&"|"&Year&"|"
&Month;First&"|"&Last&"|"&Company&"|"&Year&"|"&Month;0));RowVector);RowVector);ROWS(H$2:H2)));"")

I2 =IFERROR(INDEX(Last;SMALL(IF(FREQUENCY(IF(First<>"";MATCH(First&"|"&Last&"|"&Company&"|"&Year&"|"
&Month;First&"|"&Last&"|"&Company&"|"&Year&"|"&Month;0));RowVector);RowVector);ROWS(I$2:I2)));"")

J2 =IFERROR(INDEX(Company;SMALL(IF(FREQUENCY(IF(First<>"";MATCH(First&"|"&Last&"|"&Company&"|"&Year&"|"
&Month;First&"|"&Last&"|"&Company&"|"&Year&"|"&Month;0));RowVector);RowVector);ROWS(J$2:J2)));"")

K2 =IFERROR(INDEX(Year;SMALL(IF(FREQUENCY(IF(First<>"";MATCH(First&"|"&Last&"|"&Company&"|"&Year&"|"
&Month;First&"|"&Last&"|"&Company&"|"&Year&"|"&Month;0));RowVector);RowVector);ROWS(K$2:K2)));"")

L2 =IFERROR(INDEX(Month;SMALL(IF(FREQUENCY(IF(First<>"";MATCH(First&"|"&Last&"|"&Company&"|"&Year&"|"
&Month;First&"|"&Last&"|"&Company&"|"&Year&"|"&Month;0));RowVector);RowVector);ROWS(L$2:L2)));"")

Invoegen met alleen Enter

M2 =IF($H2="";"";SUMIFS(Amount;First;$H2;Last;$I2;Company;$J2;Year;$K2;Month;$L2))

Alle formules tenslotte doorvoeren naar beneden.

Unieke lijst genereren

9 September 2025Uncategorizedadmin

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.

Totalen berekenen, 2 criteria

9 September 2025Uncategorizedadmin

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.

Wie heeft het meest verkocht per maand/jaar

9 September 2025Uncategorizedadmin

De vertegenwoordigers hebben weer eens goed hun best gedaan maar wie heeft het meeste verkocht per maand en wie is de topverkoper van het jaar?

Formule invoeren met Ctrl+Shift+Enter

Formule in F2

=IFERROR(INDEX($B$1:$E$1;SMALL(IF($B2:$E2=MAX($B2:$E2);COLUMN($B$1:$E$1)-COLUMN($B$1)+1);COLUMNS($F2:F2)));””)

Naar beneden doorvoeren.

Bestanden in map tonen met hyperlinks

9 September 2025Uncategorizedadmin

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