Excel VBA tip 7: Een recordset maken op basis van 2 verschillende worksheets

Dit is de zevende en laatste blogpost in de reeks over technieken die datatransformatie in Excel VBA kunnen versnellen.

  1. Kopiëren van cellen met VBA
  2. Gegevens toevoegen aan een tabel
  3. Een bestand openen en data overbrengen naar het doelbestand
  4. Een reeks bestanden openen en data overbrengen naar het doelbestand
  5. Gegevens opslaan in een recordset
  6. Gegevens uit meerdere bestanden uitlezen met een recordset zonder de bestanden te openen
  7. Een recordset maken, gebaseerd op data uit 2 verschillende worksheets

In deze blogpost bespreken we de mogelijk om 2 tabellen samen te voegen en in 1 recordset op te nemen. Beide tabellen moeten minstens 1 gemeenschappelijk veld bevatten. Dat veld wordt gebruikt om de koppeling tussen de 2 datagebieden te leggen. We tonen eveneens de mogelijkheid om de gegevens te overlopen en aan te passen.

Het principe van een recordset is al in de vorige blogposts besproken. We hoeven ons deze keer enkel op de schrijfwijze van de query te concentreren. Daarna gaan we de recordset doorlopen en evalueren, waarna het aangepaste resultaat wordt weggeschreven.

In het eerste voorbeeld zullen de samengestelde data naar een nieuw werkblad gekopieerd worden. In het tweede voorbeeld gaan we de records apart verwerken.

Volgende weergave toont de data die we gebruiken en het resultaat ervan.

Ieder beeld in het voorbeeld staat op een ander werkblad. De kader rechts is het resultaat van de code die op een bestaand leeg werkblad terechtkomt.

Opmerking: Zorg dat je vóór een nieuwe run telkens de vorige resultaten wist of neem deze actie mee op in de code om een manuele tussenkomst te vermijden.

Sub CopyWithADODB()
    ' Reference to: Microsoft ActiveX Data Objects 6.1 Library
    Dim myConnection As String
    Dim RS As ADODB.Recordset
    Dim mySQL As String
    Dim strPath As String
    Dim wsMain As Worksheet
    Debug.Print Now
    Set wsMain = Worksheets("Sheet3")
    Application.ScreenUpdating = False
    strPath = ActiveWorkbook.FullName
    myConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                     "Data Source=" & strPath & ";Extended Properties=Excel 12.0"
            mySQL = "SELECT [Sheet1$].[Code],[Sheet1$].[Price] , [Sheet2$].[Units], [Sheet2$].[Tax] " & _
                "FROM [Sheet1$] INNER JOIN [Sheet2$] ON [Sheet1$].[Code] = [Sheet2$].[Code]"
        Set RS = New ADODB.Recordset
        RS.Open mySQL, myConnection, adOpenForwardOnly, adLockOptimistic
    wsMain.Range("A1").CopyFromRecordset RS
    RS.Close
    Set RS = Nothing
    Application.ScreenUpdating = True
    Debug.Print Now
End Sub

De SQL code wordt als volgt samengesteld:

"SELECT [Sheet1$].[Code],[Sheet1$].[Price] , [Sheet2$].[Units], [Sheet2$].[Tax] " & _
                "FROM [Sheet1$] INNER JOIN [Sheet2$] ON [Sheet1$].[Code] = [Sheet2$].[Code]"

Als je goed naar de schrijfwijze kijkt, herken je waarschijnlijk de schrijfwijze die door Excel gebruikt wordt voor formules in tabellen. Alleen gebruiken we hier de werkbladnaam en de naam (titel) van de kolom in plaats van de tabelnaam en de naam van de kolom.

Dit is een zeer sterk alternatief voor gebruikers die de overstap naar Power BI nog niet kunnen of willen maken. Met de juiste kennis van de SQL-query taal beschik je over een hele reeks mogelijkheden om data samen te voegen en te analyseren. Deze werkwijze is al even oud als Excel zelf.

In het volgende voorbeeld gaan we de eenheid en de prijs vermenigvuldigen om het resultaat ervan te gebruiken in plaats van de 2 basiswaarden apart.

Opmerking: Er zijn verschillende mogelijkheden om dit op te lossen maar in deze blog kies ik ervoor door de recordset te lussen (loop) en het resultaat van de berekening weg te schrijven naar Excel. Een andere oplossing zou kunnen bestaan uit een recordset met een extra kolom waarin de bewerking wordt opgeslagen. Na het doorlopen van de recordset kan je deze in zijn geheel in Excel plakken. Of je overschrijft een bestaande kolom met de oplossing om een extra kolom te vermijden. Zo verlies je wel je originele basisdata.

Hier moeten we de recordset doorlopen en rij per rij naar het Excel werkblad wegschrijven. Een extra variabele om dit rijnummer bij te houden is dus noodzakelijk.

Sub UpdateRecordSet()
    ' Reference to: Microsoft ActiveX Data Objects 6.1 Library
    Dim myConnection As String
    Dim RS As ADODB.Recordset
    Dim mySQL As String
    Dim strPath As String
    Dim wsMain As Worksheet
    Dim lngRow As Long
    Set wsMain = Worksheets("Sheet3")
    Application.ScreenUpdating = False
    strPath = ActiveWorkbook.FullName
    myConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & strPath & ";Extended Properties=Excel 12.0;"
    mySQL = "SELECT [Sheet1$].[Code],[Sheet1$].[Price] , [Sheet2$].[Units], [Sheet2$].[Tax] " & _
                "FROM [Sheet1$] INNER JOIN [Sheet2$] ON [Sheet1$].[Code] = [Sheet2$].[Code]" '* FROM “ & _
                “[Sheet1$A1:SF10000]"
    Set RS = New ADODB.Recordset
    RS.Open mySQL, myConnection, adOpenForwardOnly, adLockOptimistic
    lngRow = 1
    Do Until RS.EOF
        wsMain.Cells(lngRow, 1) = RS.Fields(0)
        wsMain.Cells(lngRow, 2) = RS.Fields(1) * RS.Fields(2)
        wsMain.Cells(lngRow, 3) = RS.Fields(3)
        lngRow = lngRow + 1
        RS.MoveNext
    Loop
    RS.Close
    Set RS = Nothing
    Application.ScreenUpdating = True
End Sub

Dit was de laatste blogpost uit een reeks van 7 die je de verschillende mogelijkheden heeft getoond in verband met het kopiëren en verplaatsen van grotere blokken data en de snelheidswinst die je hiermee kan boeken.

Ik hoop dat je de uitgewerkte voorbeelden kan gebruiken als basis om verder mee aan de slag te kunnen en zo tot een paar mooie Excel-oplossingen kan komen.

Mocht je hier dieper op willen ingaan, dan ben je altijd welkom in één van onze open Excel-opleidingen. Hopelijk tot gauw!

Deel dit blogbericht
Categorieën: Excel
Tags: Excel

Also interesting for you

Laat een antwoord achter

Uw e-mailadres wordt niet gepubliceerd. Verplichte velden zijn gemarkeerd.

Breng jouw kennis en skills naar een hoger niveau

Schrijf nu in voor onze nieuwsbrief en krijg maandelijks:

  • Exclusieve tips & tricks
  • Informatie over onze opleidingen
  • Trends in opleidingen
  • Uitnodigingen voor studiedagen en events

Meest gekozen opleidingen