• Excel start

Data genereren en toevoegen met het ListObject

Ten einde te kunnen oefenen met de rijke weergave van tabellen, filter-functionaliteiten, Pivot-tabellen en Diagram-weergaven is een aanwezigheid van subtantiële tabel gegevens noodzakelijk. Om deze niet manueel te hoeven in te geven heb ik een methode gezocht om deze automatisch te genereren gebruikmakend van het ListObject.
Teneinde verkoopsgegevens te verkrijgen voorzie ik een Werkblad data met volgende tabellen.

1. tblAgent met twee velden Naam en Regio
2. tblItem met drie velden Item Klasse en Stukprijs
3. tblVerkoop die de gegenereerde gegevens ontvangt met volgende velden:
   datum agent regio item klasse stukprijs aantal.

        Public Sub sGenereerLO()
        Dim wrkBoek As Workbook
        Dim wshTest As Worksheet
        Dim wshData As Worksheet
        Dim lsoVerkoop As ListObject
        Dim lsoAgent As ListObject
        Dim lsoItem As ListObject
        Dim rijVerkoop As ListRow
        Dim strAgent As String
        Dim strRegio As String
        Dim strItem As String
        Dim strKlasse As String
        Dim curStukprijs As Currency
        Dim intAantal As Integer
        Dim intAgent As Long
        Dim intItem As Long
        Dim intDum As Integer
        Dim datStart As Date
        Dim datEind As Date
        Dim datrand As Date
        Dim intLussen As Integer

        Set wrkBoek = ThisWorkbook
        Set wshTest = wrkBoek.Worksheets("test")
        Set wshData = wrkBoek.Worksheets("data")
        Set lsoVerkoop = wshTest.ListObjects("tblVerkoop")
        Set lsoAgent = wshData.ListObjects("tblAgent")
        Set lsoItem = wshData.ListObjects("tblItem")

        datStart = #1/1/2013#  'De datum wordt hard gecodeerd
        datEind = #12/31/2016#
        intAgent = lsoAgent.Range.Rows.Count
        intItem = lsoItem.Range.Rows.Count
            For intLussen = 1 To 3000
                intDum = fWilgetal(2, intAgent)  'Kies een willekeurige agent uit tblAgent
                strAgent = lsoAgent.Range.Cells(intDum, 1)
                strRegio = lsoAgent.Range.Cells(intDum, 2)

                intDum = fWilgetal(2, intItem) Kies een willekeurig item uit tblItem
                strItem = lsoItem.Range.Cells(intDum, 1)
                strKlasse = lsoItem.Range.Cells(intDum, 2)
                curStukprijs = lsoItem.Range.Cells(intDum, 3)
                datrand = fRandomDatum(datStart, datEind)  'een willekeurige datum tussen opgegeven grenzen
                datrand = Format(datrand, "dd/mm/yyyy")
                intAantal = fWilgetal(1, 100)
                Set rijVerkoop = lsoVerkoop.ListRows.Add(1, False)
                rijVerkoop.Range.Columns(1).Value = datrand
                rijVerkoop.Range.Columns(2).Value = strAgent
                rijVerkoop.Range.Columns(3).Value = strRegio
                rijVerkoop.Range.Columns(4).Value = strItem
                rijVerkoop.Range.Columns(5).Value = strKlasse
                rijVerkoop.Range.Columns(6).Value = curStukprijs
                rijVerkoop.Range.Columns(7).Value = intAantal
            Next intLussen
        End Sub

        Willekeurige datum tussen twee, maakt gebruik van WorksheetFunction
        Public Function fRandomDatum(startDatum As Date, eindDatum As Date) As Date
            Dim RandomDatum As Date
            RandomDatum = WorksheetFunction.RandBetween(startDatum, eindDatum)
            fRandomDatum = Format(RandomDatum, "dd/mm/yyyy")
        End Function

        Willekeurig getal tussen twee, maakt gebruik van WorksheetFunction
        Public Function fWilgetal(lngmin As Long, lngMax As Long) As Long
            fWilgetal = WorksheetFunction.RandBetween(lngmin, lngMax)
        End Function
        

Van bestaande Data een Listobject maken.

Stel een werkblad met data, inclusief kolommen.De data zijn niet gedefinieerd in een Range.
Via VBA gaan wij eerst een Range definieren en deze vervolgens omzetten naar een Tabel of ListObject
Daarbij gaan wij gebruikmaken van de functie ConvertToLetter afkomstig van https://support.microsoft.com. Deze functie zet een kolomnummer om naar de kolomletters van Excel.

        Function ConvertToLetter(iCol As Integer) As String
            Dim iAlpha As Integer
            Dim iRemainder As Integer
            iAlpha = Int(iCol / 27)
            iRemainder = iCol - (iAlpha * 26)
            If iAlpha > 0 Then
                ConvertToLetter = Chr(iAlpha + 64)
            End If
            If iRemainder > 0 Then
                ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64)
            End If
        End Function
        '############################################################
        Public Sub sRangeNaarTabel()
        Dim wsh3 As Worksheet
        Dim lngRij As Long
        Dim intKol As Integer
        Dim rngStart As Range
        Dim rngTemp As Range
        Dim lsoDef As ListObject
        Set wsh3 = ThisWorkbook.Worksheets("Sheet3")
        'verticaal zoeken
        Set rngStart = wsh3.Range("A1")
            Do While Not IsEmpty(rngStart.Value)
                Set rngStart = rngStart.Offset(1, 0)
                lngRij = lngRij + 1
            Loop
        Debug.Print "rijen: " & lngRij
        'horizontaal zoeken 
        Set rngStart = wsh3.Range("A1")
            Do While Not IsEmpty(rngStart.Value)
                Set rngStart = rngStart.Offset(0, 1)
                intKol = intKol + 1
            Loop
        Debug.Print "Kolommen: " & intKol
        'tijdelijke Range bepalen 
        Set rngTemp = wsh3.Range("A1:" & ConvertToLetter(intKol) & CStr(lngRij))
        'Listobject toevoegen 
        Set lsoDef = wsh3.ListObjects.Add(SourceType:=xlSrcRange, Source:=rngTemp) ' HasHeaders:=xlYes voor geimporteerde data
        lsoDef.Name = "tblDef"
        End Sub