wimgielis.com

Info uit alle tabbladen zoeken

• 16/12/2007

	Voorbeeldbestanden bij dit artikel:
	Info uit alle tabbladen ophalen

Inleiding

Relatief vaak zie je op Excel/VBA forums de vraag weerkeren over hoe je met VBA kan zoeken over heel het werkblad. Via Bewerken > Vervangen (Ctrl + F) kan dit wel manueel, maar dat is niet altijd handig. Stel bijvoorbeeld eens dat je 1000 zoekacties moet uitvoeren in een bestand met tientallen tabbladen. Deze vraag werd o.a. hier gesteld.

VBA-code

Ik heb code geschreven voor bovenstaande vraagsteller op Ozgrid, maar dacht bij mezelf dat ik beter de code wat algemener kon maken en hier op de site zetten. Bij deze. Ik zal eerst de code publiceren en dan de uitleg geven over hoe je dit aanpast en zelf kan gebruiken. Het doel van de code is om:

1. door een aantal cellen te gaan (je selecteert zelf welke)
2. elke cel opzoeken in het hele bestand (dus in elk tabblad behalve het blad van de selectie)
3. uit dezelfde rij maar in een andere kolom een waarde ophalen en in de cel rechts van de zoekcel zetten

Sub InfoUitTabbladen()

'1. select the cells that you want to search for
    ''in all the sheets of the file
    'note: the cells in the column to the right
    ''will be overwritten if they're not empty

'2. change the parameters in the procedure InfoUitTabbladen
    ''you can leave any of the 3 parameters empty

'3. run the procedure InfoUitTabbladen once

    Call Zoeken("D", -1, True)

End Sub

Dat is al wat je moet uitvoeren. De code van de Zoeken procedure moet je natuurlijk ook kopiëren naar VBA, anders zal het uiteraard niet werken. Deze procedure kan een aantal parameters aannemen, die optioneel zijn. Je hoeft die dus niet in te geven, al geven ze wel extra functionaliteit aan de macro.

Parameters

Dit zijn de 3 parameters (volgorde is belangrijk):

1. sKolomDoorzoeken: hier zet je de naam van de kolom die je wil doorzoeken op elk tabblad. Laat je dit leeg (zet dan ""), dan doorzoekt de code het hele tabblad.
2. iKolomVerschuiving: je haalt de waarde van een cel op uit een bepaalde kolom. Bv. -1 wil zeggen de waarde uit de kolom links van de kolom die je doorzoekt. Zet je 3, dan neem je de derde kolom rechts van de zoekkolom. Dit is dus een uitgebreide VERT.ZOEKEN functie.
3. iHeleMatch: wil je zoeken op een exacte match (zet: True of niets), of is een deel van de cel vinden al genoeg (zet: False)?

Sub Zoeken(Optional sKolomDoorzoeken As String = "", _
           Optional iKolomVerschuiving As Integer = 0, _
           Optional bHeleMatch As Boolean = True)
' Wim Gielis
' https://www.wimgielis.com
'''''
' Custom module to retrieve values form a column
'    after searching in the whole file
' 16/12/07
'''''
    Dim r As Range
    Dim ws As Worksheet
    Dim rFoundCell As Range
    Dim Match As XlLookAt
    Dim bFound As Boolean

    If bHeleMatch = True Then
        Match = xlWhole
    Else
        Match = xlPart
    End If

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Selection.Offset(0, 1).ClearContents

    For Each r In Selection

        Application.StatusBar = "Bezig met rij " & r.Row & "..."

        If Len(r.Value) > 0 Then
        '(use SpecialCells as a faster alternative)

            bFound = False
            For Each ws In ThisWorkbook.Sheets

                If ws.Name <> Selection.Parent.Name Then

                    If Len(sKolomDoorzoeken) > 0 Then
                        Set rFoundCell = ws.Columns(sKolomDoorzoeken).Find(r.Value, , xlValues, Match)
                    Else
                        Set rFoundCell = ws.Cells.Find(r.Value, , xlValues, Match)
                    End If

                    If Not rFoundCell Is Nothing Then
                        bFound = True
                        Exit For
                    End If

                End If

            Next ws

            If Not bFound Then
                r.Offset(0, 1).Value = "Niet gevonden"
            Else
                If rFoundCell.Column + iKolomVerschuiving > 0 Then
                    r.Offset(0, 1).Value = rFoundCell.Offset(0, iKolomVerschuiving).Value
                End If
            End If
        End If

    Next r

    Selection.Offset(0, 1).EntireColumn.AutoFit

    With Application
        .StatusBar = False
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        MsgBox "Klaar!", vbInformation, .UserName
    End With

End Sub

Opmerkingen

Nog enkele opmerkingen:

• De code stopt bij de eerste cel die voldoet en zoekt niet verder.
• De code zoekt niet op het blad met de selectie van de cellen. Meestal is dit ook niet gewenst, aangezien dit vaak een soort van overzichtsblad is.

Breid gerust de code zelf uit als je wil. Je zou bvb. nog andere dingen kunnen doen met de cellen die de code vindt. Veel succes!

• « Vorig Excel artikel
• Volgend Excel artikel »