Category Archives: Uncategorized

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

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.

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:

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

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..

Wildcard in verticaal zoeken

Verticaal zoeken met behulp van een zogenaamde “wildcard”. We weten niet precies hoe de renner heet maar soms wel de voornaam of een gedeelte van de naam. Uiteindelijk willen we de RiderId van die renner kunnen opzoeken.

– Tabel is A1:C22.
– In kolom A staan de namen.
– In E2 vullen we een deel van de voornaam in, bijvoorbeeld “Rem” (zonder aanhalingstekens)
– In F2 komt de formule:

=VLOOKUP("*"&E2&"*";$A$1:$C$22;3;FALSE)

– In G2 komt de formule

=VLOOKUP("*"&E2&"*";$A$1:$C$22;1;FALSE)

De formules vinden Remco Evenepoel met RiderId 21 en dat is correct.

Maar stel nou dat je wel de voornaam van Almeida weet maar bent vergeten welk teken boven de a staat. Was dat nou een ` of een ‘ of een ~. Of was die derde letter wel een a? Dan kun je in E2 invullen “Jo?o” (zonder aanhalingstekens). Dus een vraagteken op die plaats. En ja hoor de goede data wordt gevonden en staat in F2 en G2. Een vraagteken staat voor elk willekeurig karakter.

Een alternatieve manier is:

In F2:

=LOOKUP(9,999999999999999E+307;SEARCH("*"&E2&"*";$A$2:$A$22);$C$2:$C$22)

In G2:

=LOOKUP(9,99999999999999E+307;SEARCH("*"&E2&"*";$A$2:$A$22);$A$2:$A$22)

Hoogste waarde in rij markeren

Vind de hoogste waarde in elke rij en markeer die waarde. Ook als er 2 waarden even hoog zijn. Werkt ook als er een lege rij is.

Sub MarkeerHoogsteWaardeInRij()
  Dim rngRij As Range, Max As Double
  Application.ReplaceFormat.Clear
  Application.ReplaceFormat.Interior.ColorIndex = 7
  For Each rngRij In ActiveSheet.UsedRange.Rows
    rngRij.Replace Application.Max(rngRij.Value), "", SearchFormat:=False, ReplaceFormat:=True
  Next
  Application.ReplaceFormat.Clear
End Sub

Laatste n boekingen tonen

Je wilt de laatste n boekingen zien. In dit geval n=10.

De tabel staat in A1:E831 en de kolomkoppen zijn Date, Employee, Customer, Country, Price. Je hebt formules nodig om de meest recente 10 bestellingen weer te geven. Toon ze in het bereik G2:K11.

Gebruik in een hulpcel (bijv. M2) deze formule om de meest recente datum te vinden:
=MAX(A2:A831)
Dit bevestigt alleen de meest recente datum in je lijst ter referentie (heeft verder geen nut).

We willen de 10 laatste bestellingen vinden. Voer deze formule in cel G2 in als matrixformule (bevestig met Ctrl+Shift+Enter, niet alleen met Enter). Er verschijnen automatisch accolades {}.

=IFERROR(INDEX(A:A; AGGREGATE(15; 6; ROW($A$2:$A$831)/($A$2:$A$831=LARGE($A$2:$A$831; ROWS(G$2:G2))); 1)); "")

Kopieer naar rechts en dan naar beneden.

Vind kolomletter

We geven een zoekterm op en willen de kolomletter vinden waarin deze zoekterm zich bevindt. Laten we zoeken naar:

San Cristóbal

Vul die naam in onderstaande code in.

Sub Find_Column_Letter()
    Set cell = Cells.Find("San Cristóbal", , xlValues, xlPart, , , False)
    If Not cell Is Nothing Then
      ColLetter = Split(cell.Address, "$")(1)
      MsgBox ColLetter
    Else
      MsgBox "I cannot find that text on this sheet"
    End If
End Sub

De uitkomst is kolom E

Je kunt natuurlijk ook gewoon zoeken met toetscombinatie Ctrl+F en in het zoekvak de naam invullen.

Rename file names

Option Explicit

'I presume you've got a lot of file names. 10, 100 or 1000?
'- Start up command prompt (cmd.exe) and run as administrator.
'- Go to directory where your files are. Let's presume C:\temp
'- Type dir /b
'- Look for the little black icon at the top left
'- Choose Edit | Mark. You can now select your files.
'- Choose Edit | Copy
'- Go to Excel and start up a new workbook and select A1
'- Hit Paste

'Now suppose your file name is something like: Fortitude.S01E01.WEB-DL.XviD-FUM.jpg
'and you want to replace the part "WEB-DL.XviD-FUM" with "IMG_" (without quotes.)
'- Go to B1 and enter formula =SUBSTITUTE(A1;"WEB-DL.XviD-FUM.jpg";"IMG_.jpg") Attention, I use semi colon and not comma because I have Dutch version.
'- Copy down
'- Now you have your correct file names in B1
'- Copy and Paste this code in a new module -> Alt+F11 | Insert | Module
'- Run the code with View | Macros |View macros | RenameFiles | Run
'- it will pause and you have to point to the directory where your files are.

Sub RenameFiles()
Dim xDir As String
Dim xFile As String
Dim xRow As Long
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            xDir = .SelectedItems(1)
            xFile = Dir(xDir & Application.PathSeparator & "*")
            Do Until xFile = ""
                xRow = 0
                On Error Resume Next
                xRow = Application.Match(xFile, Range("A:A"), 0)
                If xRow > 0 Then Name xDir & Application.PathSeparator & xFile As _
                    xDir & Application.PathSeparator & Cells(xRow, "B").Value
                xFile = Dir
            Loop
        End If
    End With
End Sub

Dubbele waarden in kolom markeren

In kolom A staan dubbele waarden en in kolom B niet. Bijvoorbeeld in kolom A staan de bedrijfsnamen en in kolom B de adressen. Een bedrijf kan meerdere adressen hebben omdat ze ook nog in een ander land zitten. De bedrijfsnaam kan dus 2 of meerdere keren voorkomen maar het adres niet.

Als de bedrijfsnaam meerdere keren voorkomt in kolom A willen we de hele rij markeren. Zoiets:

Option Explicit
Sub Dubbele_Waarden_In_Kolom_A()
'Start rijnummer van je gegevens.
Const lngStartRij As Long = 2

Dim lngLaatsteRij As Long
Dim rngCell As Range
Dim strGegevens As String

    lngLaatsteRij = Range("A:B").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    strGegevens = "A" & lngStartRij & ":A" & lngLaatsteRij
    
    For Each rngCell In Range(strGegevens)
        If Evaluate("COUNTIF(" & strGegevens & ",A" & rngCell.Row & ")") > 1 Then
            'Dubbele waarden in kolom A rood markeren.
            Range("A" & rngCell.Row & ":B" & rngCell.Row).Interior.Color = RGB(191, 255, 128)
        End If
    Next rngCell
End Sub

Bovenstaande code als volgt invoegen:

1. Kopieer de 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. Zorg dat je een lijst met gegevens in je werkblad hebt zoals in de screenshot hierboven.
9. Macro uitvoeren via Beeld | Macro’s