Oorspronkelijk geplaatst op 23 april 2014

Stel, je wilt gegevens uit je MySql database lezen vanuit Excel. Dan moet je eerst een verbinding tot stand brengen en dat is moeilijk.
Volg deze stappen. Surf naar:
https://dev.mysql.com/downloads/connector/odbc/
Hier staat dat je een zogenaamde Connector/ODBC kunt downloaden en daar begint het al. Moet je de 32-bits of de 64-bits versie hebben. Ligt aan je Excel versie dus check dat eerst via:

Bestand | Help

Al naar gelang je versie, download je de juiste driver op de website.

Vervolgens verschijnt er nog een venster. Registreren is onnodig. Scroll naar beneden en klik gewoon op No thanks just start my download

Na het downloaden, installeer je de driver. Daarna voer je de volgende stappen uit:

1. Je moet de ODBC-gegevensbron eerst openen. Dat kan op twee manieren:
a. Klik op de knop Start, dan Configuratiescherm | Systeem en beveiliging | Systeembeheer. Of:
b. Voor de 32-bit versie > > > kies voor: Uitvoeren > > > vul in: c:\windows\sysWOW64\odbcad32.exe
Voor de 64-bit versie > > > kies voor: Uitvoeren > > > vul in: c:\windows\system32\odbcad32.exe

Nu kom je in bovenstaand overzicht. Daar kunnen 2 versies staan. Wederom 32-bit of 64-bit. Dubbelklik op de versie die overeenkomt met jouw Excel versie.

2. In het volgende venster klik je op Toevoegen

Kies het juiste stuurprogramma voor de gegevensbron die je toevoegt. Wij kiezen voor:

MySQL ODBC 5.3 ANSI Driver of de Unicode Driver.

Klik vervolgens op Voltooien.

3. Je komt nu in het venster MySql Connector/ODBC Data Source Configuration. Typ in het vak Naam van gegevensbron een naam voor de gegevensbron. Je kunt ook een beschrijving typen waaraan je later kunt zien waarvoor deze gegevensbron wordt gebruikt. Bij TCP/IP server geef je de naam van je server * op evenals User en Password. Klik op de knop Test om de verbinding te controleren. Kies je database en dan OK.

* Ik heb Xampp lokaal geïnstalleerd en standaard is daar de servernaam “Localhost” en de User is “root”. Password is niet nodig. Bij jou kunnen die gegevens dus iets anders zijn.

Nog een keer data van een website halen met VBA code. Ga in de Visual Basic Editor naar:
Extra | Verwijzingen en kruis in ieder geval aan:

– Microsoft HTML Object Library
– Microsoft XML, v6.0

De VBA code

Sub Get_That_Data_Version_2()
    Dim HTMLdoc As Object
    Dim xmlhttp As New MSXML2.XMLHTTP60
    Dim allDivs As Object, element As Object
    Dim i As Integer
    Dim ws As Worksheet
    Dim nextRow As Long
    
    ' Wijs Sheet1 toe en maak de sheet leeg voor nieuwe data
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Cells.Clear
    
    ' Schrijf de kolomkoppen in A1, B1 en C1
    ws.Range("A1").Value = "Platform"
    ws.Range("B1").Value = "Title"
    ws.Range("C1").Value = "Price"
    
    ' Zet de startrij voor de data op rij 2
    nextRow = 2
    
    Set xmlhttp = New MSXML2.XMLHTTP60
    xmlhttp.Open "GET", "https://gameshop.nl/webshop/index.php", False
    xmlhttp.send
    
    Set HTMLdoc = CreateObject("htmlfile")
    HTMLdoc.body.innerHTML = xmlhttp.responseText
    
    Set allDivs = HTMLdoc.getElementsByTagName("div")
    
    For i = 0 To allDivs.Length - 1
        Set element = allDivs.Item(i)
        
        If element.className Like "*product-card*" Then
            ' Geef het werkblad en de huidige rij mee als argumenten
            Extract_Product_Data element, ws, nextRow
        End If
    Next i
    
    ' Kolommen automatisch netjes uitlijnen qua breedte
    ws.Columns("A:C").AutoFit
    MsgBox "Data succesvol geëxporteerd naar Sheet1!", vbInformation
End Sub

Private Sub Extract_Product_Data(ByVal productBox As Object, ByVal ws As Worksheet, ByRef nextRow As Long)
    Dim subElements As Object, subEl As Object
    Dim j As Integer
    Dim platformText As String, titleText As String, priceText As String
    
    Set subElements = productBox.getElementsByTagName("*")
    
    For j = 0 To subElements.Length - 1
        Set subEl = subElements.Item(j)
        
        ' 1. PLATFORM
        If UCase(subEl.tagName) = "A" Then
            If subEl.getAttribute("href") Like "*platform=*" Then
                platformText = subEl.innerText
            End If
        End If
        
        ' 2. TITEL
        If UCase(subEl.tagName) = "H3" Then
            If subEl.getElementsByTagName("a").Length > 0 Then
                titleText = subEl.getElementsByTagName("a").Item(0).innerText
            Else
                titleText = subEl.innerText
            End If
        End If
        
        ' 3. PRIJS
        If subEl.className Like "*prijs*" Then
            priceText = subEl.innerText
        End If
    Next j
    
    ' Schrijf het resultaat naar Sheet1 in plaats van het Immediate Window
    If titleText <> "" Or priceText <> "" Then
        ws.Cells(nextRow, 1).Value = Trim(platformText) ' Kolom A
        ws.Cells(nextRow, 2).Value = Trim(titleText)    ' Kolom B
        ws.Cells(nextRow, 3).Value = Trim(priceText)    ' Kolom C
        
        ' Hoog de rij-teller op voor het volgende product
        nextRow = nextRow + 1
    End If
End Sub

Sub Get_That_Data_Version_2()
    Dim HTMLdoc As Object
    Dim xmlhttp As New MSXML2.XMLHTTP60
    Dim allDivs As Object, element As Object
    Dim i As Integer
    Dim ws As Worksheet
    Dim nextRow As Long
    
    ' Wijs Sheet1 toe en maak de sheet leeg voor nieuwe data
    Set ws = ThisWorkbook.Sheets("Sheet1")
    ws.Cells.Clear
    
    ' Schrijf de kolomkoppen in A1, B1 en C1
    ws.Range("A1").Value = "Platform"
    ws.Range("B1").Value = "Title"
    ws.Range("C1").Value = "Price"
    
    ' Zet de startrij voor de data op rij 2
    nextRow = 2
    
    Set xmlhttp = New MSXML2.XMLHTTP60
    xmlhttp.Open "GET", "https://gameshop.nl/webshop/index.php", False
    xmlhttp.send
    
    Set HTMLdoc = CreateObject("htmlfile")
    HTMLdoc.body.innerHTML = xmlhttp.responseText
    
    Set allDivs = HTMLdoc.getElementsByTagName("div")
    
    For i = 0 To allDivs.Length - 1
        Set element = allDivs.Item(i)
        
        If element.className Like "*product-card*" Then
            ' Geef het werkblad en de huidige rij mee als argumenten
            Extract_Product_Data element, ws, nextRow
        End If
    Next i
    
    ' Kolommen automatisch netjes uitlijnen qua breedte
    ws.Columns("A:C").AutoFit
    MsgBox "Data succesvol geëxporteerd naar Sheet1!", vbInformation
End Sub

Private Sub Extract_Product_Data(ByVal productBox As Object, ByVal ws As Worksheet, ByRef nextRow As Long)
    Dim subElements As Object, subEl As Object
    Dim j As Integer
    Dim platformText As String, titleText As String, priceText As String
    
    Set subElements = productBox.getElementsByTagName("*")
    
    For j = 0 To subElements.Length - 1
        Set subEl = subElements.Item(j)
        
        ' 1. PLATFORM
        If UCase(subEl.tagName) = "A" Then
            If subEl.getAttribute("href") Like "*platform=*" Then
                platformText = subEl.innerText
            End If
        End If
        
        ' 2. TITEL
        If UCase(subEl.tagName) = "H3" Then
            If subEl.getElementsByTagName("a").Length > 0 Then
                titleText = subEl.getElementsByTagName("a").Item(0).innerText
            Else
                titleText = subEl.innerText
            End If
        End If
        
        ' 3. PRIJS
        If subEl.className Like "*prijs*" Then
            priceText = subEl.innerText
        End If
    Next j
    
    ' Schrijf het resultaat naar Sheet1 in plaats van het Immediate Window
    If titleText <> "" Or priceText <> "" Then
        ws.Cells(nextRow, 1).Value = Trim(platformText) ' Kolom A
        ws.Cells(nextRow, 2).Value = Trim(titleText)    ' Kolom B
        ws.Cells(nextRow, 3).Value = Trim(priceText)    ' Kolom C
        
        ' Hoog de rij-teller op voor het volgende product
        nextRow = nextRow + 1
    End If
End Sub

Oorspronkelijk geplaatst op 24 april 2014.

Nu je een verbinding tot stand hebt gebracht met je MySql database kun je gegevens ophalen. Heb je nog geen verbinding, lees dan eerst dit bericht, “Connector/ODBC installeren”

Klik op: Gegevens | Van andere bronnen | MS Query

Je kiest de gegevensborn die je al eerder hebt aangemaakt in dit geval Unicode.

Let op ! ! ! Kruis het vak aan: “Query’s maken/bewerken met behulp van de wizard query”

Er verschijnt een mededeling: “Verbinding maken met de gegevensbron”

In het volgende venster zie je de tabellen die in je database staan. In dit voorbeeld maak ik gebruik van de tabel van “Noordenwind”. Dat is een soort voorbeeldtabel van Microsoft. Onderaan zal ik kort toelichten hoe je die voorbeeldtabellen kunt installeren.

Klik op “Noordenwind” (of je eigen tabellen) en vervolgens op het “>” teken om de tabellen toe te voegen. Ze staan nu rechts in het venster. Klik op “Volgende”.

Doorloop de venster “Filteren en Sorteren”. Tenslotte voor “Weergeven in Excel” en “Voltooien”. En voilà, daar staan de gegevens.

Je kunt de gegevens nog aanpassen door in het lint te kiezen voor de tab “Hulpmiddelen voor tabellen” en vervolgens op “Eigenschappen” te klikken.

​Let op ! ! ! Met de kleine knop rechts kun je nog meer instellen. Bijvoorbeeld of je de data wil bijwerken als de map opnieuw geopend wordt.

In de andere tab kun je de query veranderen mocht je dat willen.

Nog even over het importeren van de tabellen van ‘Noordenwind” of “Northwind” als je het Engels prefereert. Ik ga er van uit dat je al een database hebt en weet hoe je die moet benaderen. Bijvoorbeeld met het programma “phpmyadmin”.

Download dan hier het sql bestand en importeer dat in je database.

1. Pak het zip bestand uit.

2. Indien je phpmyadmin gebruikt, selecteer je je database en kiest voor importeren.

3. Klik op “Bestand kiezen” en zoek het zojuist uitgepakte sql-bestand en klik op “Start”.

Oorspronkelijk geplaatst op 24 april 20

Lees eerst deze berichten:

Connector/ODBC installeren
Gegevens ophalen met MySQL en importeren in Excel

Met onderstaande code kun je automatisch data lezen uit je MySQL database. Voorop gesteld dat je bovenstaande berichten hebt gelezen en uitgevoerd.

Sub SelecteerDataVanMySQL()
    
    Dim SQLStr As String
    Dim Cn As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim Table As String
    Dim rs As ADODB.Recordset
    Dim rngKolom As Integer
    Dim rngRij As Integer
    Dim myArray()
    Dim K As Integer
    Dim R As Integer
    
    'Set variable
    Set rs = New ADODB.Recordset
    
    'Clear the range
    Range("a5:bb60000").ClearContents
    
    'Connection properties
    Server_Name = "YOUR SERVER NAME"
    Database_Name = "YOUR DATABASE NAME"
    User_ID = "YOUR USER ID"
    Password = "YOUR PASSWORD"
    Table = "YOUR TABLE NAME"
    Field = "YOUR FIELD NAME"

    'Create a mysql query string
    SQLStr = "SELECT * FROM " & Table & " WHERE " & Field & "  = 2"
    
    'Connect to the database
    Set Cn = New ADODB.Connection
    Cn.Open "Driver={MySQL ODBC 5.3 Unicode Driver};Server=" & _ 
        Server_Name & ";Database=" & Database_Name & ";Uid=" & _
        User_ID & ";Pwd=" & Password & ";"
    
    'Create a recordset
    rs.Open SQLStr, Cn, adOpenStatic
    
    'Store rs in array variable
    myArray = rs.GetRows()
    rngKolom = UBound(myArray, 1)
    rngRij = UBound(myArray, 2)
    For K = 0 To rngKolom
        'Transfer recordset data to worksheet
        Range("A5").Offset(0, K).Value = rs.Fields(K).Name
        For R = 0 To rngRij
            Range("A5").Offset(R + 1, K).Value = myArray(K, R)
        Next
    Next
    'Close the connection
    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing
End Sub

Sub SelecteerDataVanMySQL()
    
    Dim SQLStr As String
    Dim Cn As ADODB.Connection
    Dim Server_Name As String
    Dim Database_Name As String
    Dim User_ID As String
    Dim Password As String
    Dim Table As String
    Dim rs As ADODB.Recordset
    Dim rngKolom As Integer
    Dim rngRij As Integer
    Dim myArray()
    Dim K As Integer
    Dim R As Integer
    
    'Set variable
    Set rs = New ADODB.Recordset
    
    'Clear the range
    Range("a5:bb60000").ClearContents
    
    'Connection properties
    Server_Name = "YOUR SERVER NAME"
    Database_Name = "YOUR DATABASE NAME"
    User_ID = "YOUR USER ID"
    Password = "YOUR PASSWORD"
    Table = "YOUR TABLE NAME"
    Field = "YOUR FIELD NAME"

    'Create a mysql query string
    SQLStr = "SELECT * FROM " & Table & " WHERE " & Field & "  = 2"
    
    'Connect to the database
    Set Cn = New ADODB.Connection
    Cn.Open "Driver={MySQL ODBC 5.3 Unicode Driver};Server=" & _ 
        Server_Name & ";Database=" & Database_Name & ";Uid=" & _
        User_ID & ";Pwd=" & Password & ";"
    
    'Create a recordset
    rs.Open SQLStr, Cn, adOpenStatic
    
    'Store rs in array variable
    myArray = rs.GetRows()
    rngKolom = UBound(myArray, 1)
    rngRij = UBound(myArray, 2)
    For K = 0 To rngKolom
        'Transfer recordset data to worksheet
        Range("A5").Offset(0, K).Value = rs.Fields(K).Name
        For R = 0 To rngRij
            Range("A5").Offset(R + 1, K).Value = myArray(K, R)
        Next
    Next
    'Close the connection
    rs.Close
    Set rs = Nothing
    Cn.Close
    Set Cn = Nothing
End Sub

Functie heeft een verwijzing nodig.
In de VBE, Extra | Verwijzingen
Microsoft VBScript Regular Expressions 5.5

Handige functie om de HTML tags uit een webpage te verwijderen.

Function stripHTML(strHTML)

    'Strips the HTML tags from strHTML
    Dim objRegExp, strOutput
    Set objRegExp = New Regexp

    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    objRegExp.Pattern = "<(.|\n)+?>"

    'Replace all HTML tag matches with the empty string
    strOutput = objRegExp.Replace(strHTML, "")

    'Replace all < and > with < and >
    strOutput = Replace(strOutput, "<", "<")
    strOutput = Replace(strOutput, ">", ">")
    
    'Return the value of strOutput
    stripHTML = strOutput

    Set objRegExp = Nothing
End Function

Function stripHTML(strHTML)

    'Strips the HTML tags from strHTML
    Dim objRegExp, strOutput
    Set objRegExp = New Regexp

    objRegExp.IgnoreCase = True
    objRegExp.Global = True
    objRegExp.Pattern = "<(.|\n)+?>"

    'Replace all HTML tag matches with the empty string
    strOutput = objRegExp.Replace(strHTML, "")

    'Replace all < and > with < and >
    strOutput = Replace(strOutput, "<", "<")
    strOutput = Replace(strOutput, ">", ">")
    
    'Return the value of strOutput
    stripHTML = strOutput

    Set objRegExp = Nothing
End Function

Oorspronkelijk geplaatst op 26 april 2014

Heb je ooit geprobeerd een waarde op te zoeken die links ligt t.o.v. de zoekkolom? Dan heb je gemerkt dat de functie VERT.ZOEKEN niet werkt. Voor die gelegenheid heb je de functies INDEX en VERGELIJKEN nodig.

De functie VERGELIJKEN zoekt de waarde in C6 en geeft als resultaat de positie (en die is 5). Die positie wordt in de functie INDEX gebruikt om de 5e waarde in kolom A op te zoeken (en dat is bloemkool . . . lekker ! ! !).

Oorspronkelijk geplaatst op 26 april 2014

Medewerkers in de gezondheidszorg of andere beroepen krijgen vaak een onregelmatigheidstoeslag uitbetaald. De volgende tabel berekent het aantal uren die betaald moeten worden volgens de percentages die daarbij horen.
In dit voorbeeld, 22%, 38%, 44%, 49% en 60%. De tabel houdt rekening met het gegeven als de uren over middernacht gaan.
Bijvoorbeeld van 22:45 – 07:15.

Het handige is dat je tegelijk kunt zien over welke uren (welke periodes) wordt betaald. Namelijk in de kolommen F en G.

De start- en eindtijd van een dienst kun je invullen in B3:C3. Je moet de opmaak wel op uren zetten, [uu:mm]. Dat geldt trouwens voor alle cellen waar uren staan. De tijden worden als decimalen weergegeven in D3 en E3. De waarde in E3 wordt aangepast indien deze na middernacht ligt. [E3]=ALS(C3<B3;1+C3;C3).

Aangezien er nogal wat formules in de cellen staan, hier een visueel overzicht:

Oorspronkelijk geplaatst op 26 april 2014

De functie VERT.ZOEKEN wordt gebruikt om gegevens te zoeken.

VERT.ZOEKEN eist dat de te zoeken waarde zich in de meest linkse kolom bevindt. Vervolgens wordt een veld dat meer naar rechts en in dezelfde rij ligt als resultaat gegeven.

Door de functies VERT.ZOEKEN en KIEZEN te combineren kun je een formule maken die van rechts naar links zoekt. Op die manier kun je elke waarde opzoeken onafhankelijk van de kolom.

De formule:
=VERT.ZOEKEN(C4;KIEZEN({1\2};C2:C92;A2:A92);2;ONWAAR)

Wat gebeurt hier? KIEZEN zorgt er voor dat VERT.ZOEKEN als het ware voor de gek wordt gehouden. We kunnen elke bedrijfsnaam (in kolom A) opzoeken door Id in C4 (ANTON) te gebruiken. VERT.ZOEKEN “denkt” dat kolom C kolom A is en omgekeerd.

Nog een voorbeeld:

Oorspronkelijk geplaatst op 26 april 2014

Functie spreekt voor zich.

Kies Formules | Functie invoegen | Door gebruiker gedefinieerd
Geef een getal of celverwijzing op. Klaar!

Function dhIsPrime(ByVal lngX As Long) As Boolean
    ' Find out whether a given number is Prime.
    ' Treats negative numbers and positive numbers
    ' the same.
    
    ' From "VBA Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 1997; Sybex, Inc. All rights reserved.
    
    ' In:
    '   lngX:
    '       Number to test if Prime
    ' Out:
    '   Return Value:
    '       Returns TRUE if the number is Prime
    
    Dim intI As Integer
    Dim dblTemp As Double
    dhIsPrime = True
    lngX = Abs(lngX)
    
    If lngX = 0 Or lngX = 1 Then
        dhIsPrime = False
    ElseIf lngX = 2 Then
        ' dhIsPrime is already set to True.
    ElseIf (lngX And 1) = 0 Then
        dhIsPrime = False
    Else
        For intI = 3 To Int(Sqr(lngX)) Step 2
            dblTemp = lngX / intI
            If dblTemp = lngX \ intI Then
                dhIsPrime = False
                Exit Function
            End If
        Next intI
    End If
End Function

Function dhIsPrime(ByVal lngX As Long) As Boolean
    ' Find out whether a given number is Prime.
    ' Treats negative numbers and positive numbers
    ' the same.
    
    ' From "VBA Developer's Handbook"
    ' by Ken Getz and Mike Gilbert
    ' Copyright 1997; Sybex, Inc. All rights reserved.
    
    ' In:
    '   lngX:
    '       Number to test if Prime
    ' Out:
    '   Return Value:
    '       Returns TRUE if the number is Prime
    
    Dim intI As Integer
    Dim dblTemp As Double
    dhIsPrime = True
    lngX = Abs(lngX)
    
    If lngX = 0 Or lngX = 1 Then
        dhIsPrime = False
    ElseIf lngX = 2 Then
        ' dhIsPrime is already set to True.
    ElseIf (lngX And 1) = 0 Then
        dhIsPrime = False
    Else
        For intI = 3 To Int(Sqr(lngX)) Step 2
            dblTemp = lngX / intI
            If dblTemp = lngX \ intI Then
                dhIsPrime = False
                Exit Function
            End If
        Next intI
    End If
End Function

From “VBA Developer’s Handbook”

By Ken Getz and Mike Gilbert

Copyright 1997; Sybex, Inc. All rights reserved.

Oorspronkelijk geplaatst op 26 april 2014

Zoals gebruikelijk staat de N voor de grote onbekende. M.a.w. je kunt een getal kiezen.

In dit voorbeeld nemen we het getal 3.

Stel je hebt een heel lange lijst met data. Bijvoorbeeld voetbalwedstrijden. In kolom A en B staan de ploegen en in kolom C een waardering van de wedstrijd uitgedrukt in een cijfer. Dezelfde ploeg mag/kan meerdere keren voorkomen in dezelfde kolom.

Nu wil je van een ploeg de waardering van alleen de laatste 3 wedstrijden optellen ook al komt die ploeg 6 keer voor in de lijst. In onderstaand voorbeeld willen we de waardering van de laatste 3 wedstrijden van Feyenoord optellen.

Ik vond het wel een verbazingwekkende formule. Voor alternatieve toepassingen, zelf creatief denken.

Cel A23
Vul een club in.

Cel B23:
Let op ! ! ! Formule is gesplitst vanwege layout problemen.
=SOM(ALS(ISGETAL(VERGELIJKEN(RIJ($A$2:$A$21);GROOTSTE(ALS($A$2:$A$21=A23; RIJ($A$2:$A$21));RIJ(INDIRECT(“1:”&C23)));0));$C$2:$C$21))

Let op ! ! ! Invoeren als Matrixformule. Dus met: Ctrl+Shift+Enter. Er verschijnen dan accolades om de gehele formule { }.

Cel C23:
=MIN(3;AANTAL.ALS($A$2:$A$21;A23))

Cel D23
Ons getal, namelijk 3 (de laatste 3 wedstrijden).