For...next lus om data in kolom A te converteren naar tabel

[Warme bakkertje]

Zonder enkele schoonheidsfoutjes.

Sub M_snb()
    sn = Application.Transpose(ActiveSheet.UsedRange.Columns(1))
    On Error Resume Next
    Set tbl = ActiveSheet.ListObjects(1)
    With tbl.DataBodyRange
        .Resize(.Rows.Count, .Columns.Count).Rows.Delete
    End With
    With CreateObject("scripting.dictionary")
        For j = 1 To UBound(sn) Step 10
            .Item(.Count) = Array(sn(j), sn(j + 1), sn(j + 2), sn(j + 3), sn(j + 4), sn(j + 5), sn(j + 6), sn(j + 7), sn(j + 8), sn(j + 9))
        Next
        Cells(1, 4).Resize(.Count, 10) = Application.Index(.items, 0, 0)
        With ActiveSheet.ListObjects.Add(xlSrcRange, ActiveSheet.Cells(1, 4).CurrentRegion, , xlYes)
            .Name = "Tabel3"
            .TableStyle = "TableStyleLight6"
        End With
    End With
End Sub

 

[snb]

Zet een VBA-code in de macromodule van het werkblad/Userform waarop de code betrekking (lezen/schrijven) heeft; in dit geval Blad1

 

[Warme bakkertje]

In Post#9 is er gesproken over meerdere werkbladen waarop deze code moet werken dus ze elke keer in elke werkbladmodule herhalen ....

 

[RoVo1211]

@Warme bakkertje:
Ik heb jouw macro proberen te ontleden en mij vallen verschillende dingen op:
M_snb:
1) op de eerste regel roep je de macro "DeleteTable" aan, maar daarna ga je noch terug naar M_snb noch naar MakeTable en blijf je dus hangen in DeleteTable;
2) de rest van M_snb wordt voor zover ik het kan overzien nooit uitgevoerd;

DeleteTable:
3) in DeleteTable ga je er kennelijk vanuit dat er al een ListObject is, maar van de tabel moet juist een ListObject gemaakt worden;
4) er wordt een range gedeclareerd met de naam rng en ik zie wel een "Set rng = .Range". Waar verwijst ".Range" naar?
5) Waar verwijst "On error resume next" naar?
6) Wat betekent ".Unlist"? Het terug converteren van een ListObject naar een bereik (range)?

MakeTable:
7) Volgens mij komt deze macro nooit tot actie, zie 1) en 2).

M.a.w. het lukt mij dus niet! Tevens krijg ik een foutmelding bij de regel:

 With sheets(2).ListObjects(1) ' OF sheets("blad2"), maar ik gebruik meestal de sheet-nummers en niet de sheet-namen.

De foutmelding is "Het subscript valt buiten het bereik".
Waarschijnlijk omdat er helemaal nog geen tabel is.

Ik krijg de indruk dat mijn vraag niet goed begrepen is, al weet ik niet hoe ik de vraag anders moet stellen.

 

[RoVo1211]

In Post#9 is er gesproken over meerdere werkbladen waarop deze code moet werken dus ze elke keer in elke werkbladmodule herhalen ....

Nee hoor, het gaat doorgaans over 2 werkbladen:
Sheets(1): de originele data;
sheets(2): de data in tabel formaat, maar nog niet opgemaakt als tabel.

Dat was nou juist de vraag: hoe kan ik tabel met variabele lengte (=aantal records)
"Opmaken als tabel" in de groep "Stijlen" van het tabblad "Start" of
"Tabel" in de groep "Tabellen" van het tabblad "Invoegen"?
Deze twee opties hebben hetzelfde resultaat.

Zoals ik in #18 al schreef: als ik een macro opneem om van een tabel een ListObject te maken, dan zie je in VBA alleen absolute cel-adressen en ik wil juist dat ik met een macro van een tabel van iedere lengte een ListObject kan maken.

 

[snb]

Gebruik het bestand in #22

 

[RoVo1211]

Ik ben niet zo blij met de oplossing van #22 omdat ik de conversie-macro van kolom A naar tabel (zonder tabel-opmaak) in een persoonlijke werkmap heb staan. Dan hoef ik de macro niet in elk bestand te zetten.

De macro die ik nu heb voor de conversie zet de cel-aanwijzer automatisch in A1. Als ik dan "Opmaken als tabel" aanklik wordt ListObject automatisch groot genoeg gemaakt.

 

[AHulpje]

Zo dan misschien:

Sub Transponeren()
    arr = Sheets("Blad1").UsedRange
    With Sheets("Blad2")
        For i = 0 To UBound(arr) / 10 - 1
            For k = 1 To 10
                r = i * 10 + k
                .Cells(i + 1, k) = arr(r, 1)
            Next
        Next
        .Activate
        .ListObjects.Add xlSrcRange, .UsedRange, , xlYes
    End With
End Sub

 

[Warme bakkertje]

Als je dan enkel en alleen de code nodig hebt om een tabel te maken op het 2de blad vanaf cel A1

dan volstaat dit.

Sub MaakTabel()
    Dim ws As Worksheet
    Set ws = Sheets(2)
    With ws.ListObjects.Add(xlSrcRange, ws.Cells(1, 1).CurrentRegion, , xlYes)
        .Name = "Tabel3"
        .TableStyle = "TableStyleLight6"
    End With
End Sub

Onthoud echter dat dit een éénmalige actie is en je geen tweede tabel (met meer of minder rijen) kan

maken op dezelfde plaats.

 

[RoVo1211]

Jij bent echt een goede hulplijn, Rudi.
Dit is precies wat ik wilde bereiken. Nu hoef ik alleen de data van de website in een nieuw bestand te plakken, macro uitvoeren en opslaan. Daarna het bestand invoegen in Access als OLE-object en klaar is Kees.

Mocht je je nog geroepen voelen om ook het opslaan in de macro op te nemen, waarbij er nog ruimte is om zelf de naam te bepalen, dan houd ik me aanbevolen.

Heel veel dank alvast.

Voel je niet verplicht! Het is geen aangenomen werk!

 

[RoVo1211]

@Warme bakkertje : Dit is een voorbeeld van een deel van het eindresultaat.

 

[AHulpje]

Tabel wordt getransponeerd en als .jpg opgeslagen:

 

[snb]

Nu hoef ik alleen de data van de website in een nieuw bestand te plakken

Bestudeer eerst eens hoofdstuk 12 van je Excel handboek.

 

[RoVo1211]

Bestudeer eerst eens hoofdstuk 12 van je Excel handboek.

Het handboek voor Excel of voor VBA?

 

[RoVo1211]

Tabel wordt getransponeerd en als .jpg opgeslagen:

Bedankt Rudi, maar ik geef er de voorkeur aan om het als excel-bestand op te slaan en niet als afbeelding.

Daarvoor heb ik een dialoogvenster gemaakt:

en de onderstaande macro geschreven:

Private Sub cmd_Opslaan_Click()
Dim str_Path As String, _
    str_Filename As String, _
    str_Name As String, _
    str_Ext As String, _
    str_Loads As String, _
    str_EersteLetter As String

str_EersteLetter = Left(txt_Oliepatroon, 1)
str_Path = "C:\Users\rvo_s\OneDrive\Documenten\MS Access\NBF\NMTL\Oliepatronen\" & str_EersteLetter & "\" & txt_Oliepatroon & "\"
    
If opt_Forward Then
    str_Loads = "Forward Loads"
Else
    str_Loads = "Reverse Loads"
End If
    
If txt_Ext = "" Then
    str_Ext = ", "
ElseIf txt_Ext = "V2" Then
    str_Ext = " " & txt_Ext & ", "
Else
    str_Ext = "(" & txt_Ext & "), "
End If

str_Name = txt_Oliepatroon & str_Ext & str_Loads & ".xlsx"
str_Filename = str_Path & str_Name

Debug.Print vbNewLine & _
    str_EersteLetter, str_Loads, str_Ext, str_Path, str_Filename & vbNewLine & _
    str_Filename
Unload Me

ActiveWorkbook.SaveAs Filename:=str_Filename 'Hier strandt de macro

End Sub

.
De output die ik uit de debug.print krijg is:

Ik krijg de volgende foutmelding:
"Fout 1004 tijdens uitvoering.
Het document is niet opgeslagen".

Het boek dat ik gebruik om macro's te leren schrijven is "Excel VBA voor professionals" van Wim de Groot.
Op pagina 382 staat alleen een voorbeeld om een bestand op te slaan als ".xlsm" (fileformat:=52), maar niet hoe ik een bestand kan opslaan met de extensie ".xlsx". Weet jij welk fileformat dat is?
Hieronder het voorbeeld uit het boek:

 

[AHulpje]

Het is natuurlijk veel handiger als je het betreffende document hier plaatst.

 

[snb]

Ook jouw VBEditor heeft een object browser waarin je alles vindt wat Wim vergeten is.
En 20 regels code voor een bestandnaam is overkill; 7 variabelen natuurlijk ook.

 

[AHulpje]

Je zou zoiets kunnen inbouwen in je formulier, ervan uitgaand dat Activesheet het werkblad met de getransponeerde tabel is:

Function SaveAsXLSX()
    filenaam = "jouw hele verhaal.xlsx"
    ActiveSheet.Copy
    ActiveWorkbook.SaveAs filenaam, 51
    ActiveWorkbook.Close
    MsgBox "Bestand opgeslagen: " & filenaam
End Function

 

[RoVo1211]

Ik heb het met minder code geprobeerd en die debug.print hoef je natuurlijk niet mee te rekenen.

Van de object-browser wordt IK niets wijzer.

Om maar een voorbeeld te noemen:
Bij de functie VERT.ZOEKEN in Excel staat keurig vermeld wat de parameters zijn (Zoekwaarde,Tabelmatrix,Kolomindex_getal,Benaderen), maar bij het equivalent Vlookup in VBA staat in de object-browser alleen maar Vlookup(arg1,arg2,arg3,arg4) en mag je zelf gaan uitzoeken wat de exacte volgorde is. Er staat ook geen enkele uitleg bij.

Een ander willekeurig voorbeeld:
bij Asc staat "function Asc(String as String) as Integer;
bij AscB staat "function AscB(String as String) as Byte"-> dat zegt tenminste dat het over Bytes gaat;
maar bij AscW staat alleen maar "function AscW(String as String) as Integer", maar geen uitleg wat het verschil is tussen Asc en AscW en waarom die "W" erachter staat.

Nu een iets concreter voorbeeld:
bij "ActiveWorkbook" staat in de 'toelichting' alleen maar:
"Property ActiveWorkbook as Workbook
alleen lezen
Lid van Excel.Global".
Verder geen uitleg wat je er verder mee kan, zoals bijvoorbeeld: ActiveWorkbook.SaveAs.

Als ik kijk wat de argumenten zijn bij SaveAs, krijg je een hele rits argumenten, maar niet wat ik zoek zoals bijvoorbeeld het fileformat# voor .xlsx.
Ik heb ook op internet gezocht naar fileformat nummer, daar is de uitleg wel wat uitgebreider maar geen lijst van fileformat-nummers.
Ik heb echt wel wat research gedaan voordat ik op dit forum een vraag stel, misschien dat ik niet de juiste vragen stel op internet. Ik gebruik vaak de letterlijke termen van VBA.

 

[AHulpje]

Ik heet geen Rudi en ook geen Wim, maar heb wel e.e.a. toegevoegd aan jouw Userform, zie bijlage.
Het getransponeerde werkblad wordt nu opgeslagen als .xlsx bestand met de door jou samengestelde (complexe) folder- en filenaam. Moet je in Userform1 nog wel even

str_Path = ActiveWorkbook.Path & "\"

wijzigen in jouw directorystructuur.