Lijst met namen opmaken vanuit HTML

[SmitLC]

Beste Helpers,

Ik ben met de hulp van een aantal van jullie al een heel einde gekomen maar een aantal zaken lukken me helaas nog niet, ik zal hieronder een uiteenzetting geven van wat ik probeer te bewerkstelligen.

Ik kan uit een programma wat we op mijn werk gebruiken een lijst met bewoners genereren in HTML formaat.

Het lukt me om dit bestand dmv een macro te importeren in excel maar eigenlijk wil ik maar een aantal kolommen overnemen in Excel, zoals: ruimte/achternaam/voornaam/geb. datum en geslacht.

Daarna heb ik een macro welke uit de kolom met achternamen de verschillende achternamen splitst naar de cellen ernaast.

Tot zover oke maar na het uitvoeren van die 2 macro's houd ik een html bestand over en heb ik teveel stappen doorlopen om het voor mijn collega's ook nog behapbaar te kunnen maken.

Het mooiste zou zijn als we een vast Excel bestand zouden kunnen openen met daarin een of twee knoppen om te komen tot het eindresultaat zoals ik voor ogen heb.

Ik ben tot gisteren nog nooit eerder aan het werk geweest met macro's en begrijp dan ook nog lang niet alles, vooral bijvoorbeeld "hoe maak ik een Excel bestand waarin de macro's opgeslagen blijven want die lijken te verdwijnen bij mij?

Ik zal de code's bijvoegen zoals ik nu heb en een voorbeeld van wat het zou moeten worden.

De code om het HTML bestand te importeren.

Dim wb As Excel.Workbook
Set wb = Workbooks.Open("G:\Desktop\Documenten Leon\Bewonerslijst Alkmaar RW.html")

En de code om de achternamen te splitsen.

Sub AchternamenSplitsen()
'
' AchternamenSplitsen Macro
'
' Sneltoets: CTRL+SHIFT+M
'
Dim X As Integer, Y As Integer, RijTeller As Long, Spatie(10) As Integer, c As Range
Dim Voorvoegsel As String, Achternaam As String, Naam As String, Voornaam As String
Dim cl As Range

Voorvoeg = MsgBox("Wilt u de voorvoegsels in een aparte kolom?", vbYesNo)
    If Voorvoeg = vbNo Then
        StopZoek = MsgBox("Wilt u de voorvoegsels (van der, v/d) naar de kolom van de achternamen meekopiëren?", vbYesNo)
    End If

For Each c In Range("J1", Range("J" & Rows.Count).End(xlUp).Address)
     If cl Is Nothing Then
     Set cl = c
     cl.Offset(, 1).Resize(, 2).EntireColumn.Insert
 End If
    Naam = Replace(Trim(c.Value), "  ", " ")
    Y = 0
    Spatie(1) = 0
    For X = 1 To Len(Naam) ' Zoeken naar eerste spatie
        If Mid(Naam, X, 1) = " " Then
            Y = Y + 1
            Spatie(Y) = X
            If StopZoek = vbYes Then Exit For ' Voorvoegsels bij Achternaam.
        End If
    Next
    
    If Spatie(1) <> 0 Then ' Spatie gevonden
        If Voorvoeg = vbNo Then
            If StopZoek = vbYes Then Y = 1
            Voornaam = Mid(Naam, 1, Spatie(Y) - 1)
            c = Voornaam
            Achternaam = Mid(Naam, Spatie(Y) + 1)
            c.Offset(, 1) = Achternaam
        Else ' Voorvoegsels apart naar kolom C
            Voornaam = Mid(Naam, 1, Spatie(1) - 1)
            c = Voornaam
            Achternaam = Mid(Naam, Spatie(Y) + 1)
            c.Offset(, 1) = Achternaam
            If Y > 1 Then
                Voorvoegsel = Mid(Naam, Spatie(1), Spatie(Y) - Spatie(1) + 1)
                c.Offset(, 2) = Trim(Voorvoegsel)
            End If
        End If
    Else ' Naam naar kolom K
        c = Naam
    End If
Next
End Sub

En het Excel bestand zoals we nu gebruiken.
Bekijk bijlage Originele postlijst-test.xlsx

Ik hoop dat mijn uiteenzetting duidelijk genoeg is en dat iets dergelijks is te creëren en ik ben bij voorbaat dankbaar voor alle geboden hulp.

 

[wampier]

Kun je alleen HTML genereren? geen CSV, XML, JSON? de data staat als plain text in de HTML, geen tables? Anders loop je extra werk te verzinnen waar het niet nodig is

qua macro's verliezen: save je wel als xlsm ?

 

[plongske]

Anders genoemd. Sla het bestand op als ( opslaan als gebruiken) Excel- werkmap met macro's.
Je kan ook opslaan als Binaire werkmap om de macro's te behouden.verder zal ik u niet kunnen helpen wegens te weinig kennis met macro's

 

[SmitLC]

Helaas kan ik inderdaad alleen HTML genereren, en voor zover ik weet is dat plain text.
Ander probleem is dat er in dat HTML document kolommen staan die in het uiteindelijke document helemaal niet nodig zijn, en het geheel moet ook nog werkbaar blijven voor mijn collega's. En ja ik save als xlsm, maar volgens is dat probleem nu opgelost.

 

[VenA]

Kan je even een voorbeeldje van Bewonerslijst Alkmaar RW.html plaatsen. Natuurlijk wel anonimiseren als je de structuur maar intact laat.

Ik denk dat het het meest eenvoudig is om een template te maken waarin je het bestand importeert en daar vervolgens de bewerkingenop te doen. Je kan dan het hele proces onder één knop zetten. Met het voorbeeldje wat je nu geplaatst heb kan ik niet zoveel omdat dit het eind resultaat is.

 

[wampier]

De lijst bevat inderdaad een table die je direct kan bewerken. De vraag is nu wat je het liefste wil. Je kunt alleen de data importeren die je echt wil, of je huidige methode gebruiken en de HTML importeren in excel en gewoon kolommen weggooien.

Wel ook wat vragen: wat/wie genereert de "initialen" kolom? Hoe belangrijk is een accurate leeftijd? Je huidige methode levert inaccurate data rond de verjaardagen en met schrikkeljaren.

Zoals ik het nu zie kun je de HTML importeren in een file, kolommen wegsnijden en de data die je wil hebben importeren in je excel file. vervolgens de andere (tijdelijke) file afsluiten

 

[SmitLC]

Het zou het mooiste zijn om alleen die data te importeren die nodig is voor de uiteindelijke lijst (geeft ook het minste problemen met de collega's)
Voor de kolom initialen dacht ik de formule =LINKS te gaan gebruiken, vandaar ook dat het nodig is om alle namen te splitsen naar meerdere kolommen, of iemand moet een beter idee hebben, ik sta open voor alle mogelijke opties.
Wat betreft de data, die is redelijk cruciaal aangezien minder jarigen hun eigen post niet op mogen halen, dus zou knap ***lig zijn als diegene op de dag van zijn 18e verjaardag alsnog zijn post niet krijgt omdat het niet goed op de lijst staat.

Zoals ik het nu zie zouden dus de volgende stappen doorlopen kunnen worden:

1. HTML genereren uit programma met bewoners gegevens.
2. Uit deze HTML de kolommen importeren naar een Excel template (hoop dat dit kan of dat op een andere manier de opmaak gedaan kan worden)
3. Dan een macro de namen laten splitsen.
4. Dan de formule de kolom met initialen laten maken.

Het mooiste zou zijn als dit valt te creëren met een snel koppeling op het bureaublad of anders met een paar knoppen in het eerste tab blad en dat de uiteindelijke lijst dan in een tab blad verderop terechtkomt, dat gaan de collega's namelijk nog wel begrijpen.

Kleine achtergrond achter dit geheel, wij gebruiken op dit moment een excel bestand zoals ik eerder had bijgevoegd met de naam postlijst of iets dergelijks, het betreft hier dan ook een lijst waarop de bewoners van het object kunnen zien of er post voor hun is, wij gebruiken hiertoe achter de balie een lijst met ruimte nummer en volledige namen, en voor de bewoners hangen we een lijst op met ruimte nummer en initialen.

We hebben dan ook een lege kolom aan het einde staan waar een * ingezet wordt bij de bewoners die post hebben, daarna selecteren we dmv een filter alle cellen met een * en printen dit uit.

Ooit zou ik dit laatste gedeelte ook willen automatiseren maar als eerst het samenstellen van de lijst maar eens lukt dmv het verwerken van het HTML bestand ipv het dagelijks handmatig bijwerken waardoor er fouten ontstaan.

Op voorhand alvast weer mijn hartelijke dank aan een ieder die meedenkt en met (een deel van) de oplossing komt.

 

[VenA]

Ik zie nergens initialen staan hoe deze eruit te halen lijkt mij dan ook onmogelijk. Om de achternaam te splitsen kan je net zo goed tekst naar kolommen gebruiken. Ik kom tot zoiets met de gesplitste achternaam aan het eind van de tabel. Je moet nog wel even het pad aanpassen naar jouw eigen situatie.

Sub VenA()
Dim ar
Application.ScreenUpdating = False
With Workbooks.Open("D:\Temp\Bewonerslijst.html")
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
End With

With Sheets("Volledige lijst")
    .UsedRange.Clear
    For j = 3 To UBound(ar) - 2
        ar(j, 14) = DateDiff("yyyy", ar(j, 12), Date)
    Next j
    .Cells(1).Resize(UBound(ar), UBound(ar, 2)).Value = ar
    .Columns(2).Resize(, 8).EntireColumn.Delete
    .Columns(2).TextToColumns Range("G1"), xlDelimited, xlDoubleQuote, , , , , True
    With .Cells(3, 1)
        .EntireRow.Insert
        .Resize(, 9) = Array("Ruimte", "Achternaam", "Voornaam", "Geb-datum", "Geslacht", "Leeftijd", "Achter#1", "Achter#2", "Achter#3")
    End With
    .[B2] = Trim(Split(.[A2], ":")(1))
    .[A2].Clear
    .Columns(1).Resize(, 9).EntireColumn.AutoFit
End With
End Sub

Het resultaat zoals ik het krijg staat in het bestandje.

 

[SmitLC]

Wow hier kan ik echt iets mee VenA, onwijs bedankt.
Als het goed is kun je met de formule =LINKS steeds de eerste letter uit een cel halen, dus met een beetje geluk kan ik die er nog ergens in verwerken.
En de opmaak kan die eventueel ook gelijk aangepast worden met dezelfde macro? daar ga ik zelf ook nog even naar zoeken.

 

[wampier]

Overigens is het niet nodig om de cel te splitsen om de initialen te genereren. Het is prima mogelijk om de initialen te genereren met de tabel in de originele vorm. Ik zie het voordeel niet om alles in meer kolommen te proppen alleen om de initialen te creeren. Vooral als je eventueel later meer "intelligentie" toe wil voegen zoals je meld in je post.

Ik heb helaas even geen toegang tot een PC met excel, maar ik kan de formule om de initialen te genereren later even toevoegen.

 

[SmitLC]

Dat zou helemaal geweldig zijn wampier, dan hoeven de namen inderdaad niet gesplitst te worden, dat was nodig om met de formule =LINKS te kunnen gaan werken.

 

[VenA]

Wat zijn in jouw optiek initialen? In mijn optiek hebben deze alleen te maken met de voorna(a)m(en). Als ook de achterna(a)m(en) meedoen dan kan je deze proberen.

With Sheets("Volledige lijst")
    .UsedRange.Clear
    For j = 3 To UBound(ar) - 2
        ar(j, 14) = DateDiff("yyyy", ar(j, 12), Date)
        If Trim(ar(j, 10)) <> "" Then
            For jj = 0 To UBound(Split(Trim(ar(j, 10))))
                ar(j, 15) = ar(j, 15) & Left(Split(ar(j, 10))(jj), 1) & "."
            Next jj
        End If
        If Trim(ar(j, 11)) <> "" Then
            For jj = 0 To UBound(Split(Trim(ar(j, 11))))
                ar(j, 15) = ar(j, 15) & Left(Split(ar(j, 11))(jj), 1) & "."
            Next jj
        End If
    Next j
    .Cells(1).Resize(UBound(ar), UBound(ar, 2)).Value = ar
    .Columns(2).Resize(, 8).EntireColumn.Delete
    With .Cells(3, 1)
     .EntireRow.Insert
     .Resize(, 7) = Array("Ruimte", "Achternaam", "Voornaam", "Geb-datum", "Geslacht", "Leeftijd", "Initialen")
    End With
    .[B2] = Trim(Split(.[A2], ":")(1))
    .[A2].Clear
    .Columns(1).Resize(, 7).EntireColumn.AutoFit
End With

 

[snb]

@VenA

.Columns(2).Resize(, 8).EntireColumn.Delete = .Columns(2).Resize(, 8).Delete

.Columns(1).Resize(, 7).EntireColumn.AutoFit= .Columns(1).Resize(, 7).AutoFit

 

[SmitLC]

Beste VenA, deze werkt nog beter dan je vorige code, ik wordt hier echt heel blij van.
Alleen heb ik nu het werkblad opgemaakt met een groter lettertype Calibri 14), maar kolom A wordt op de een of andere manier elke keer weer verkleind naar 11 ipv 14.
Ik ga me morgen verder verdiepen in de mogelijkheden om de opmaak te laten bepalen door de macro, dit kan toch?

 

[VenA]

@snb,

.Columns(2).Resize(, 8).EntireColumn.Delete = .Columns(2).Resize(, 8).Delete
Deze kan ik niet begrijpen. Waar toets je op? Of waarom toets je erop? Het zijn kolommen die niet nodig zijn en dus weg kunnen.

.Columns(1).Resize(, 7).EntireColumn.AutoFit= .Columns(1).Resize(, 7).AutoFit
Om te toetsen of kolommen al 'AutoFit' zijn? Wat is hier de meerwaarde van?

 

[VenA]

Je werkt voor het COA? En een simpele administratie moet gemaakt worden via een forum?

 

[HSV]

@snb,
Wat is hier de meerwaarde van?

Als ik zo vrij mag zijn;

'entirecolumn' = overbodig.

 

[SmitLC]

Je werkt voor het COA? En een simpele administratie moet gemaakt worden via een forum?

Ik werk inderdaad bij het COA, en die administratie staat al in een heel uitgebreid programma, maar wij verwerken snachts de post voor de bewoners en dat gaat tot nu toe via een excel sheet die telkens met de hand bijgewerkt moet worden aan de hand van in en uitstroom gegevens, of door de uitdraai naast het excel bestand te leggen en dan 1 voor 1 te controleren.
Dit is nogal omslachtig en niet alle collega's zijn hierin consequent, als beveiliger heb je ook nogal eens wat anders te doen in de nacht en dan ontstaan er fouten in de lijst waardoor belangrijke post van advocaten en dergelijken bij de receptie blijft liggen omdat de bewoners niet beseffen dat er post voor hun is, bijvoorbeeld omdat ze in een andere kamer verblijven dan op de lijst staat of hun initialen zijn verkeerd overgenomen.
Om dit te ondervangen ben ik gaan onderzoeken of er mogelijkheden waren om de gegevens uit het eerder genoemde programma in Excel te kunnen zetten, ik ben redelijk handig met formules in Excel maar VBA was een heel ander verhaal en zodoende ben ik bij dit forum uitgekomen, en ben dan ook iedereen die mij geholpen heeft om te komen wat ik nu heb heel erg dankbaar!!!:thumb::thumb::thumb:
En dit is wat ik er tot zover van heb gemaakt.
Bekijk bijlage Template Bewonerslijst.xlsb

 

[snb]

Gebruik ingebouwde Excelfaciliteiten.

Sub M_snb()
  With GetObject("C:\Users\C\Documents\Leon\Trigion\Alkmaar 2\Postlijst\Bewonerslijst.html")
    ar = .Sheets(1).Cells(1).CurrentRegion
    .Close 0
  End With

  With Sheets("Import Lijst")
   .UsedRange.Clear
   For j = 3 To UBound(ar) - 2
        ar(j, 14) = DateDiff("yyyy", ar(j, 12), Date)
        c00 = Trim(ar(j, 10) & " " & ar(j, 11))
        If c00 <> "" Then
            For jj = 0 To UBound(Split(c00))
                ar(j, 15) = ar(j, 15) & Left(Split(c00)(jj), 1) & "."
            Next jj
        End If
    Next j
    
    .Cells(1).Resize(UBound(ar), UBound(ar, 2)).Value = ar
    .Columns(2).Resize(, 8).Delete
    With .Cells(3, 1)
     .EntireRow.Insert
     .Resize(, 8) = Array("Ruimte", "Achternaam", "Voornaam", "Geb.datum", "Geslacht", "Leeftijd", "Initialen", "Post")
    End With
    .[B2] = Trim(Split(.[A2], ":")(1))
    .[A2].Clear
    .Columns(1).Resize(, 7).AutoFit
    .Cells(5, 1).Select
    .ListObjects.Add
  End With
End Sub

Volgens mij hebben alle bewoners een IND-registratienummer.
De post wordt hopelijk gesorteerd op verblijfsruimte.
De postlijst kan dan bestaan uit het nummer van de verblijfsruimte, gecombineerd met het IND-registratienummer (ondubbelzinniger kan niet).
Het gebruik van initialen is niet ondubbelzinnig en kan tot (soms fatale) fouten leiden.

Gebruik de tabel (listobject) in Excel voor eenvoudige opmaak. Geen enkele macro voor nodig (en zeker niet die je nu gebruikt).

 

[SmitLC]

Beste snb, ik zou bijna denken dat je een collega bent, de post wordt inderdaad gesorteerd op ruimte nummer. Ik ben ook van mening dat een sortering met bijvoorbeeld het V-nummer beter zou zijn, maar de lijst voor bewoners wordt voor zover ik weet op elke locatie opgemaakt uit ruimte nummer en initialen en dan zouden wij de bewoners (en mijn collega's) op onze locatie opnieuw moeten gaan uitleggen hoe het werkt.
Verder weer bedankt voor je tips, ik ben gewoon wat dingen aan het proberen geweest maar het kan blijkbaar nog veel beter/netter.