Category Archives: Uncategorized

Post or page can not been placed into a specific category, group, or classification

Afhankelijke keuzelijst

Gegevensvalidatie is handig om de gebruiker een bepaalde lijst te laten zien afhankelijk van de keuze die de gebruiker maakt.

Stel, we hebben 2 landen. Nederland en België. Afhankelijk van de landkeuze die de gebruiker in D1 maakt (druk op de pijl naast het vak), krijgt hij de bijbehorende provincies te zien in E1 (druk weer op de pijl naast het vak).

– Plaats de gegevens in je werkblad in het bereik A1:B13 zoals in de eerste screenshot.
– Landen in A1 (Nederland) en B1 (België). Daaronder de provincies.
– Ga naar Data | Data validation


– Selecteer onder Allow | List en voer bij Source in: =$A$1:$B$1 en klik OK
– Selecteer de volledige dataset (A1:B13 in dit voorbeeld).
– Klik de toetscombinatie Ctrl+Shift+F3


– Vink in het dialoogvenster ‘Create names from values in selection’ de optie ‘Top row’ aan en deselecteer alle andere opties. Hierdoor ontstaan ​​twee naambereiken (‘Nederland’ en ‘België’). Nederland verwijst naar alle Provincies van Nederland en België verwijst naar alle provincies in België. Klik OK.

– Ga naar opnieuw naar Data | Data validation en selecteer weer List en bij Source voer je in:
=INDIRECT(D1). Klik op OK.


– Wanneer je nu een selectie maakt in D1, worden de opties in E1 automatisch bijgewerkt en kun je daar een provincie kiezen..

Vind mijn printer

Ooit gevonden in een van de nieuwsgroepen over Excel. Als je in een netwerk hangt waarbinnen meerdere printers zijn geïnstalleerd, is het handig om de JUISTE printer te vinden. In onderstaand voorbeeld wordt naar de Canon TS51000 gezocht en selecteert deze. Eenmaal geselecteerd kun je die gebruiken om je document af te drukken.

Let op ! ! !
Op 64-bit systemen gebruik je het woord ptrSafe in de declaratiesectie Private Declare PtrSafe Function etc. Op 32-bit systemen kun je dat woord wissen.

Option Explicit
Private Declare PtrSafe Function GetProfileString Lib "kernel32" _
Alias "GetProfileStringA" (ByVal lpAppName As String, _
ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long) As Long

Sub test()
Dim vaList

'Get all printers
vaList = PrinterFind

'Show me
MsgBox Join(vaList, vbLf), , "List of printers"

'Get all HP Photosmart printers
vaList = PrinterFind(Match:="Photosmart")

'Switch to the first Photosmart found
If UBound(vaList) = -1 Then
    MsgBox "Printer not found"
ElseIf MsgBox( _
    "from " & vbTab & ": " & ActivePrinter & vbLf & "to " & _
    vbTab & ": " & vaList(0), vbOKCancel, _
    "Switch Printers") = vbOK Then
    Application.ActivePrinter = vaList(0)
End If

End Sub

Public Function PrinterFind(Optional Match As String) As Variant
Dim n%, lRet&, sBuf$, sCon$, aPrn
Const lLen& = 1024, sKey$ = "devices"

'******************************************************************
'Geschreven door keepITcool
'Vereist xl2000 of nieuwer.
'Geeft als resultaat een zerobased matrix van geïnstalleerde printers
'De resultaten worden gefilterd op basis van het argument "Match string" (niet hoofdletter gevoelig),
'Indien geen resultaten dan is de bovengrens -1
'******************************************************************

'Split ActivePrinter string to get localized word for "on"
aPrn = Split(Excel.ActivePrinter)
sCon = " " & aPrn(UBound(aPrn) - 1) & " "

'Read all installed printers (1k bytes s/b enough)
sBuf = Space(lLen)
lRet = GetProfileString(sKey, vbNullString, vbNullString, sBuf, lLen)

If lRet = 0 Then
    Err.Raise vbObjectError + 513, , "Can't read Profile"
    Exit Function
End If

'Split buffer string to a zero based array
aPrn = Split(Left(sBuf, lRet - 1), vbNullChar)

'Optionally Filter the array on Match
If Match <> vbNullString Then aPrn = Filter(aPrn, Match, -1, 1)

'Append localized "on" and 16bit portname for each Printer
For n = LBound(aPrn) To UBound(aPrn)
    sBuf = Space(lLen)
    lRet = GetProfileString(sKey, aPrn(n), vbNullString, sBuf, lLen)
    aPrn(n) = aPrn(n) & sCon & _
    Mid(sBuf, InStr(sBuf, ",") + 1, lRet - InStr(sBuf, ","))
Next

'Return the result
PrinterFind = aPrn

End Function

Welke ODBC driver gebruik ik?

ODBC wordt gebruikt om gegevens uit een database naar Excel te halen. ODBC staat voor Open Database Connectivity. Kun je verder vergeten. Om te weten of het stuurprogramma (de driver) geïnstalleerd is kun je onderstaande functie gebruiken

Public Function Get_Driver() As String
    Const HKEY_LOCAL_MACHINE = &H80000002
    Dim l_Registry As Object
    Dim l_RegStr As Variant
    Dim l_RegArr As Variant
    Dim l_RegValue As Variant

    Get_Driver = ""
    Set l_Registry = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
    l_Registry.enumvalues HKEY_LOCAL_MACHINE, "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers", l_RegStr, l_RegArr

    For Each l_RegValue In l_RegStr
        If InStr(1, l_RegValue, "MySQL ODBC", vbTextCompare) > 0 Then
            Get_Driver = l_RegValue
            Exit For
        End If
    Next
    Set l_Registry = Nothing
End Function

Als je alle stuurprogramma’s op je computer wil tonen gebruik je onderstaande code:

Public Function Alle_ODBC_Stuurprogramma_Tonen(strComputerNaam)
Const HKEY_LOCAL_MACHINE = &H80000002
'*************************************************************************
'Naam:      Alle_ODBC_Stuurprogramma_Tonen
'Gemaakt:   07/08/2011
'Auteur:    Dennis Hemken
'Doel:      Geeft een lijst van alle geïnstalleerde stuurprogramma's
'           in een nieuw excel document
'*************************************************************************
Dim objRegistry
Dim strRegPath
Dim strAODBCDriverNames
Dim strAValueTypes
Dim strODBCDriverName
Dim strValue
Dim objExcel
Dim objRange
Dim lngRow
Dim i
 
    Set objExcel = CreateObject("Excel.Application")
  
    objExcel.Visible = True
    objExcel.Workbooks.Add
    lngRow = 1
    objExcel.Cells(lngRow, 1).Value = "Driver Name"
    objExcel.Cells(lngRow, 2).Value = "Value"
     
    objExcel.Cells(lngRow, 1).Font.Bold = True
    objExcel.Cells(lngRow, 2).Font.Bold = True
 
    strRegPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
     
    Set objRegistry = GetObject("winmgmts:\\" & _
    strComputerNaam & "\root\default:StdRegProv")
     
    objRegistry.EnumValues HKEY_LOCAL_MACHINE, _
    strRegPath, strAODBCDriverNames, strAValueTypes
 
    For i = 0 To UBound(strAODBCDriverNames)
        lngRow = lngRow + 1
         
        strODBCDriverName = strAODBCDriverNames(i)
        objRegistry.GetStringValue HKEY_LOCAL_MACHINE, _
        strRegPath, strODBCDriverName, strValue
        objExcel.Cells(lngRow, 1).Value = strODBCDriverName
        objExcel.Cells(lngRow, 2).Value = strValue
    Next
     
    Set objRange = objExcel.Range("A1")
    objRange.Activate
    Set objRange = objExcel.ActiveCell.EntireColumn
    objRange.Columns.AutoFit
    Set objRange = objExcel.Range("B1")
    objRange.Activate
    Set objRange = objExcel.ActiveCell.EntireColumn
    objRange.Columns.AutoFit
End Function

Resultaat:

Namen splitsen

In kolom A staan de namen (aan elkaar). Er wordt gesplitst op basis van hoofdletter. Bijvoorbeeld: JopPannenkoek wordt Jop Pannenkoek.

Formule in B2:
=LOOKUP(2^15;FIND({“A”;”B”;”C”;”D”;”E”;”F”;”G”;”H”;”I”;”J”;”K”;”L”;
“M”;”N”;”O”;”P”;”Q”;”R”;”S”;”T”;”U”;”V”;”W”;”X”;”Y”;”Z”};RIGHT(A2;LEN(A2)-1)))+1

Formule in C2:
=LEFT(A2;B2-1)

Formule in D2:
=REPLACE(A2;1;B2-1;””)

B2C2 én D2 selecteren en naar beneden trekken al naar gelang de hoeveelheid namen.

Transponeren met de functie INDEX

Een bereik met gegevens transponeren (= rijen en kolommen verwisselen) met gebruik van de functies INDEX, KOLOMMEN en RIJEN. Als je de functie TRANSPONEREN niet wil gebruiken is dit een goed alternatief.

De functie INDEX geeft als resultaat de waarde van een item in een tabel. De waarde van het item wordt gevonden op het snijpunt van het rijnummer en het kolomnummer.

Voorbeeld:
=INDEX(Tabel;Rijnummer;Kolomnummer)

Ofwel:
=INDEX(A1:N10;10;5) = Waarde

Stel, een tabel in het bereik A1:N10.
10 = het rijnummer en 5 is het kolomnummer.
De functie INDEX vindt in onderstaande tabel de waarde van het item op het snijpunt van de 10e rij en de 5e kolom. Die waarde = 48

De functie COLUMNS(Range) geeft het aantal kolommen in het opgegeven bereik. Het zelfde geldt voor de functie ROWS(Range).

Voorbeeld:
COLUMNS(C1:E4) geeft 3, namelijk kolom C, D en E.
ROWS(C1:E4) geeft 4, namelijk rij 1, 2, 3 en 4.

Deze 2 functies zijn ideaal om als een zogenaamde teller te fungeren. Ik bedoel daarmee, als je een waarde met telkens 1 wilt verhogen.
Bijvoorbeeld: 1 – 2 – 3 – 4 – 5  óf  22 – 23 – 24 – 25 – 26.

Hoe gaat dat in zijn werk? Plaats onderstaande formule in een cel Bijvoorbeeld in A10:

=COLUMNS($A$2:A2)

Door die formule 5x naar rechts te kopiëren, krijg je de volgende (cijfer)reeks:
1 – 2 – 3 – 4 – 5

Je ziet dat de eerste parameter van COLUMNS($A$2) een absolute verwijzing is (mét dollartekens). De tweede parameter verschuift telkens omdat het een relatieve verwijzing is (geen dollartekens). Namelijk A2, B2, C2, D2 en E2. Hierdoor wordt het bereik, en het aantal kolommen, steeds groter wat resulteert in de waarden
1 – 2 – 3 – 4 – 5

Je kunt met de functie INDEX dus iets opzoeken.

Je kunt echter ook je gegevens anders ordenen bijvoorbeeld van vertikaal naar horizontaal. Dat noemen we transponeren. Hiervoor combineer je de functies INDEX, KOLOMMEN en RIJEN.

Maar let op ! ! ! Het paradoxale is dat als je in dit voorbeeld de rijen telkens met 1 wil laten oplopen je de functie KOLOMMEN gebruikt en als je de kolommen met 1 wil laten oplopen je de functie RIJEN moet gebruiken.

We nemen weer de tabel in het bereik A1:N10 zoals in de eerste screenshot bovenaan te zien is.In cel A14 plaats je de volgende formule:
=INDEX($A$1:$N$10;COLUMNS($A$1:A1);ROWS($A$1:$A1))
Kopieer deze formule naar rechts tot J14 en naar beneden tot J27
Merk op dat de cijfers in de rijen nu in kolommen staan en andersom.

Ontbrekende nummers vinden

Razend snelle manier om ontbrekende nummers te vinden in een reeks. De reeks staat in kolom A.

De ontbrekende nummers verschijnen in kolom B.

Let op ! ! ! De reeks moet met 1 beginnen. Binnen 3 seconden voor een reeks met 400.000 nummers.

1. Kopieer de onderstaande code
2. Open een nieuwe werkmap
3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
5. Druk op M om een standaard module in te voegen
6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel
8. Druk op de toetscombinatie ALT + F8 om de Macro Dialoog te tonen. Dubbeklik op de macro naam om te starten.

Option Explicit
Sub Ontbrekende_Nummers()
Dim lngX As Long, lngY As Long, lngZ As Long, varNummers As Variant
Dim varOntbreken As Variant
  varNummers = Range("A1", Cells(Rows.Count, "A").End(xlUp))
  ReDim varOntbreken(1 To varNummers(UBound(varNummers), 1), 1 To 1)
  lngZ = 1
  For lngX = 1 To UBound(varOntbreken)
    If lngX <> varNummers(lngZ, 1) Then
      lngY = lngY + 1
      varOntbreken(lngY, 1) = lngX
    Else
      lngZ = lngZ + 1
    End If
  Next
  Range("B1").Resize(UBound(varOntbreken)) = varOntbreken
End Sub

In kolom A 400.000 cijfers geplaatst waarvan er 4 ontbreken. De ontbrekende cijfers staan in kolom B

Tekst-terugloop in één cel, gegevens splitsen

Items staan in één cel namelijk A1. En er is sprake van tekst terugloop door voor elk nieuw item eerst Alt+ Enter te geven. Hierdoor komt elk item op een nieuwe regel. We willen die items echter splitsen en elk item in een eigen cel plaatsen zodat het overzichtelijker wordt. Zie screenshot:

Dit kan op 4 manieren:
– Met een simpele formule die je in B1 invoert en vervolgens naar rechts sleept (2x)
– Met VBA (2x)

In[B1] =TRIM(MID(SUBSTITUTE($A1; CHAR(10); REPT(" "; 100)); (COLUMN(A1)-1)*100+1; 100))
en naar rechts slepen.

1. Kopieer de onderstaande code
2. Open een nieuwe werkmap
3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
5. Druk op M om een standaard module in te voegen
6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel

Function SplitText(ByVal Cell As Range, ByVal LineNumber As Integer) As String
    Dim Lines As Variant
    Lines = Split(Cell.Value, Chr(10))
    If LineNumber - 1 <= UBound(Lines) Then
        SplitText = Lines(LineNumber - 1)
    Else
        SplitText = ""
    End If
End Function

Aangezien dit een functie is moet je nog één ding doen namelijk in B1 de volgende formule zetten:

In[B1] =SplitText($A1; COLUMN()-1)
en naar rechts slepen.

En de derde manier is ook VBA code:

Option Explicit
Sub Tekst_Terugloop_Van_Cel_Naar_Rij()
    Dim WsNieuw As Worksheet, rngBereik As Range
    Dim lngRij As Long, lngKolom As Long, lngVolgende As Long
    Dim lngTeller As Long, Data As Variant
    
    'Nieuw werkblad invoegen
    Set WsNieuw = Worksheets.Add
    
    'rngBereik is waar de gegevens staan
    With Worksheets("Sheet1")
        Set rngBereik = .Range("A1").CurrentRegion
        
        'Eerste rij met kolomtitels kopiëren
        rngBereik.Rows(1).Copy WsNieuw.Range("A1")
        lngVolgende = 2
        With rngBereik
            
            'Alle rijen doorlopen
            For lngRij = 2 To .Rows.Count
                lngTeller = 0
                
                'Alle kolommen doorlopen
                For lngKolom = 1 To .Columns.Count
                    
                    'Gegevens in cel splitsen
                    Data = Split(.Cells(lngRij, lngKolom).Value, _
                    Chr(10))
                    
                    'Gespliste gegevens wegschrijven naar rijen
                    WsNieuw.Cells(lngVolgende, lngKolom).Resize _
                    (UBound(Data) + 1).Value = Application.Transpose(Data)
                    
                    lngTeller = WorksheetFunction.Max(lngTeller, _
                    UBound(Data) + 1)
                Next lngKolom
                lngVolgende = lngVolgende + lngTeller
            Next lngRij
        End With
    End With
    WsNieuw.Cells.EntireColumn.AutoFit
End Sub

En de vierde manier:

in [B1] =TRIM(MID(SUBSTITUTE($A1;CHAR(10); REPT(" ";99));COLUMNS($A:A)*99-98;99))
en naar rechts slepen.

Schrijf celinhoud naar bestand

Schrijf celinhoud naar bestand C:\temp\textfile.html

Stel, je hebt in cel A1 de volgende tekst staan en je wilt die tekst naar een bestand schrijven.
“Lorem ipsum dolor sit amet, consectetur adipisicing elit,[ . . . ] sunt in culpa qui officia deserunt mollit anim id est laborum.”

Function Schrijf_Naar_Bestand(strCelInhoud As String) As Boolean
    Const LogFileName As String = "C:\temp\textfile.html"
    Dim FileNum As Integer
    
    'Volgende bestandsnummer
    FileNum = FreeFile
    
    'Maakt bestand aan indien niet aanwezig
    Open LogFileName For Append As #FileNum
    
    'Schrijft informatie weg aan het einde van het bestand
    Print #FileNum, strCelInhoud
    
    'Sluit het bestand
    Close #FileNum
    
    'Gelukt
    Schrijf_Naar_Bestand = True
End Function

1. Kopieer de bovenstaande code
2. Open een nieuwe werkmap
3. Druk op de toetscombinatie ALT + F11 om de Visual Basic Editor te openen
4. Druk op de toetscombinatie ALT + N om het menu Invoegen te openen
5. Druk op M om een standaard module in te voegen
6. Daar waar de cursor knippert voeg je de code in middels Ctrl + V
7. Druk op de toetscombinatie ALT + Q om de Editor af te sluiten en terug te keren naar Excel
8. Plaats in een andere cel de volgende functie: =Schrijf_Naar_Bestand(A1)

Sommeer de 1e, 2e, 3e, 4e en 5e grootste waarden in E2:E25

=LARGE(array,k)

De functie LARGE gebruikt een array met waarden in E2:E25. In waarde k geef je aan welke waarde je wil hebben, bijvoorbeeld de 5e waarde. Wij willen de 1e, 2e, 3e, 4e en 5e grootste waarden uit het bereik E2:E25.

Resultaat: {211,22; 193,37; 176,48; 79,25; 79,25}
oftewel:
€ 211,22
€ 193,37
€ 176,48
€ 79,25
€ 79,25

Formule in [G8] =SUM(LARGE($E$2:$E$25; {1;2;3;4;5}))

Het somt de vorige resulterende waarden op.
Resultaat: € 739,57