Documenten vergelijken en wijziging in kleur in hoofdbestand

[wilcovanee]

Ik ben opzoek naar een oplossing voor het volgende:

Ik heb een aantal exceldocumenten, een hoofdbestand en meerdere werkbestanden.
Het hoofdbestand is een database met meer dan 50.000 regels en 10 kolommen. De werk werkbestanden zijn het zelfde als het hoofdbestand, alleen met aanvullingen/wijzigingen. Deze wijzigingen zijn aangegeven met een kleur (rood).
Hoe kan ik deze wijzigingen aan het hoofdbestand toevoegen met Visual Basic.
Ik heb 2 voorbeeldbestanden toegevoegd.

 

[huijb]

Visual Basic is iets anders dan Visual Basic for Applications, VBA is programmeren binnen Office applicaties. Ik ga er dus vanuit dat dit VBA betreft. Verplaatst naar juiste sectie.

 

[Elsendoorn2134]

Wilco

Eerst een vraagje, je hebt het over meerdere werkbestanden en een hoofdbestand.
Staan ook in de werkbestanden alle 50.000 records of zijn dit subsets met bijvoorbeeld 10.000 regels van het hoofdbestand.
Als er meerdere werkbestanden zijn komen in verschillende werkbestanden dezelfde regels voor?
Komt bijvoorbeeld Artikelnummer 1001 in meerdere werkbestanden voor?

Elsendoorn2134

 

[wilcovanee]

De werkbestanden zijn in het begin een kopie van het hoofdbestand. De werkbestanden worden door verschillende personen aangevuld/gewijzigd, waarbij het artikelnummer altijd blijft bestaan.

 

[Elsendoorn2134]

Wilco,

Dat begrijp ik maar als er in twee bestanden wijzigingen kunnen worden bijgehouden in het zelfde artikelnummer,
hoe houd je dan bij welk bestand je moet verwerken?

Elsendoorn2134

 

[OctaFish]

More to the point, want je gaf in je eerste bericht al aan dat de werkbestanden hetzelfde zijn als het hoofdbestand, en dan zijn ze dus in principe identiek (anders is het geen kopie), als er in meerdere bestanden wijzigingen worden bijgehouden, hoe weet je dan welk record in welk werkbestand het meest recente is? En dus moet worden gebruikt? Je kunt niet uitgaan van de laatste bijwerkdatum van het werkbestand, want dat zegt niks over de bijgewerkte gegevens. Dus hou je per mutatie ook bij wanneer die heeft plaatsgevonden?

 

[wilcovanee]

Iedereen heeft zijn eigen deel wat ingevuld moet worden, dus het zal niet voorkomen dat één artikelnummers in meerdere bestanden worden bijgewerkt.

Alles wat verandert is zal een rode kleur krijgen, dit is dan ook gelijk de meest recente versie, die uiteindelijk dan weer in het hoofdbestand terecht zal komen. Wanneer deze in het hoofdbestand staan zal ik dit doorgeven en kan men de rode kleur weer zwart maken, zodat ik deze de volgende keer niet weer in het hoofdbestand zal zetten. Op zich niet zo'n probleem wanneer dit wel gebeurt, want er wordt dan gewoon het zelfde neergezet.

 

[Elsendoorn2134]

Wilco,

Hierbij een mogelijke oplossing.
Ik heb in het hoofdbestand een macro opgenomen die alle bestanden in dezelfde subdirectory staan als
het hoofdbestand, deze opent en probeert te lezen.
Als een cel is rood gekleurd wordt de hele regel gekopieerd naar het hoofdbestand waarbij het
artikelnummer eerst in het hoofdbestand wordt op gezocht.
Daarna wordt de opmaak teruggezet naar zwart zodat aangegeven is dat de regels zijn bijgewerkt.

Veel Succes.

Bekijk bijlage HelpMijHoofdbestand.xlsm
Bekijk bijlage HelpMijWerkbestand01.xlsx

 

[wilcovanee]

Ziet er op het eerste oog goed uit!! Ik heb nog wel iets wat bij mij niet goed loopt.
Ik heb als test een tweede werkbestand gemaakt (HelpMijWerkbestand02.xlsx), alleen hier worden de gegevens niet uitgehaald.

Edit:
De kleuren werden in het werkbestand niet aangepast, dit was een foutje in het script, er stond twee keer de zelfde regel ".Offset(nTeller, 1).Font.Color = vbBlack"

Ik zag ook dat er een controle in zit op het artikelnummer. Super!

 

[wilcovanee]

Dit probleem heb ik opgelost. Na het sluiten van het document laat ik de teller op nul zetten dmv "nTeller = 0"

Het hoofdbestand heb ik aangepast naar mijn eigen documenten. Met een paar documenten van 500 regels (en 14 kolommen) werkt het perfect. Wanneer ik het volledige aantal regels gebruik (zijn er nu 33470) dan krijg ik de volgende foutmelding:

"fout 6 tijdens uitvoering overloop"

Hoe kan ik dit oplossen?

 

[Elsendoorn2134]

Wilco,

Op welk punt krijg je de foutmelding, op welke regel?

Elsendoorn2134

 

[wilcovanee]

De foutmelding krijg ik bij regel 23

 

[Elsendoorn2134]

Wilco,

Ik vermoed dat je dus de aanroep van de SchrijfNaarHoofdbestand bedoeld.
Kun je ook aangeven wat de gegevens zijn voor het artikelnummer, de Site en de Foto variabele
op het punt dat het fout optreed, ik vermoed dat hier ergens het probleem ligt.

Elsendoorn2134

 

[wilcovanee]

Ik heb het een en ander getest

Wanneer ik de waarde van nTeller bekijk als de foutmelding optreed, dan zie ik dat er op de volgende regel een wijziging zit. Verplaats ik de regel naar bijv regel 10 en zet het artikelnummer van regel 10 ervoor (dus artikelnummer wijzigen), dan loopt hij netjes door deze regel en treed de volgende fout pas weer bij een artikelnummer waarvan de regelnummer ver afwijkt dan van het hoofdbestand.

- Wanneer er van een groot aantal regels geen cel gekopieerd hoeft te worden naar het hoofdbestand dan krijg ik de melding.
- Wanneer er een groot verschil zit in regelnummer van het artikelnummer van het werkbestand en hoofdbestand dan krijg ik ook de foutmelding.

 

[Elsendoorn2134]

Wilco,

Ik begrijp niet hoe de fout kan ontstaan.
Kun je een testbestand maken waarin deze fout ontstaat, zodat ik kan gaan testen?
nTeller is van het type Long en zou een groter getal aan moeten kunnen dan er regels in een Excel sheet passen.
Verder heb je het over 14 kolommen, dus ik vermoed dat je de macro hebt aangepast.
Kun je me de macro sturen zoals je deze uiteindelijk gebruikt en geef hierbij even aan waar de fout optreed door
de regel een kleur te geven of vet af te drukken.

Elsendoorn2134

 

[wilcovanee]

Ik heb 2 testbestanden. Wanneer je de macro uitvoert krijg je de foutmelding te zien. Deze zit in regel 23 (SchrijfNaarHoofdbestand). nTeller staat dan op 1499. Op regel 1500 heb ik een aantal cellen die naar het hoofdbestand gekopieerd moeten worden, wat niet goed gaat.

Bekijk bijlage Databasehoofdbestand.xlsm
Bekijk bijlage Database 2012-KD.xlsx

 

[Warme bakkertje]

Probeer het eens met deze.

Public Sub UpdateHoofdbestand()
'Open werkbestand
Dim sBestand As String, sOpbouwWerkbestand As String, nUpdate As Boolean
sOpbouwWerkbestand = "Database 2012-*.xlsx"
Application.ScreenUpdating = False
'Ophalen eerste bestand.
sBestand = Dir(ThisWorkbook.Path & "\" & sOpbouwWerkbestand)
Do While sBestand <> ""
    'Openen bestand
    Workbooks.Open ThisWorkbook.Path & "\" & sBestand
    nUpdate = False
    With Sheets("Blad 1").Range("A1")
        'Loop door alle regels en stel vast of de font kleur van de kolom D t/m C rood is.
        Do While .Offset(nTeller, 0) <> ""
            For i = 3 To 12
                If .Offset(nTeller, i).Font.Color = vbRed Then nUpdate = True
            Next
            If nUpdate = True Then
                fNumber = .Offset(nTeller, 0).Value
                sq = .Offset(nTeller, 3).Resize(, 10)
                With ThisWorkbook.Sheets("Blad 1")
                    fRow = Application.Match(fNumber, .Columns(1), 0)
                    If IsError(fRow) Then MsgBox "Het nummer " & fNumber & " uit " & sBestand & " is niet gevonden in deze database !" _
                            & vbLf & vbLf & "Er zijn geen gegevens gewijzigd voor dit nummer !": GoTo vervolg
                    .Cells(fRow, 4).Resize(, 10) = sq
                End With
                'Regel gelezen dus font omzetten naar zwart.
                .Offset(nTeller, 3).Resize(, 10).Font.Color = vbBlack
            End If
vervolg:
            'Naar de volgende regel
            nTeller = nTeller + 1: update = False
        Loop
    End With
    'Sluit huidig werkbestand.
    Workbooks(sBestand).Close True
    'Volgende bestandsnaam ophalen
    sBestand = Dir
    nTeller = 0
Loop
Application.ScreenUpdating = True
MsgBox "Alle werkbestanden zijn verwerkt", vbInformation, "Klaar"
End Sub

 

[Elsendoorn2134]

Wilco,

@Warm bakkertje: Kun jij de fout reproduceren?
Ik heb je bestanden uitgebreid getest maar ik kan de fout niet reproduceren, bij loopt de macro tot het einde toe goed door.

Loopt er misschien nog een macro mee die reageert op het veranderen op wijzigingen in de werkmap of iets dergelijks.
Zo niet dan kan ik je vrees ik niet verder helpen.

Elsendoorn2134

 

[wilcovanee]

Probeer het eens met deze.

Public Sub UpdateHoofdbestand()
'Open werkbestand
Dim sBestand As String, sOpbouwWerkbestand As String, nUpdate As Boolean
sOpbouwWerkbestand = "Database 2012-*.xlsx"
Application.ScreenUpdating = False
'Ophalen eerste bestand.
sBestand = Dir(ThisWorkbook.Path & "\" & sOpbouwWerkbestand)
Do While sBestand <> ""
    'Openen bestand
    Workbooks.Open ThisWorkbook.Path & "\" & sBestand
    nUpdate = False
    With Sheets("Blad 1").Range("A1")
        'Loop door alle regels en stel vast of de font kleur van de kolom D t/m C rood is.
        Do While .Offset(nTeller, 0) <> ""
            For i = 3 To 12
                If .Offset(nTeller, i).Font.Color = vbRed Then nUpdate = True
            Next
            If nUpdate = True Then
                fNumber = .Offset(nTeller, 0).Value
                sq = .Offset(nTeller, 3).Resize(, 10)
                With ThisWorkbook.Sheets("Blad 1")
                    fRow = Application.Match(fNumber, .Columns(1), 0)
                    If IsError(fRow) Then MsgBox "Het nummer " & fNumber & " uit " & sBestand & " is niet gevonden in deze database !" _
                            & vbLf & vbLf & "Er zijn geen gegevens gewijzigd voor dit nummer !": GoTo vervolg
                    .Cells(fRow, 4).Resize(, 10) = sq
                End With
                'Regel gelezen dus font omzetten naar zwart.
                .Offset(nTeller, 3).Resize(, 10).Font.Color = vbBlack
            End If
vervolg:
            'Naar de volgende regel
            nTeller = nTeller + 1: update = False
        Loop
    End With
    'Sluit huidig werkbestand.
    Workbooks(sBestand).Close True
    'Volgende bestandsnaam ophalen
    sBestand = Dir
    nTeller = 0
Loop
Application.ScreenUpdating = True
MsgBox "Alle werkbestanden zijn verwerkt", vbInformation, "Klaar"
End Sub

Deze loopt zonder foutmelding door, echter vanaf de eerste rode font kopieert hij alles wat hierna komt ook van het werkbestand naar het hoofdbestand (dus ook wat niet rood is) tot het eind van het document. Ik heb als test even regel 28 verandert naar:

.Offset(nTeller, 3).Resize(, 10).Font.Color = vbBlue

Wat er nu moet gebeuren is dat alleen de rode font wat gekopieerd wordt naar het hoofdbestand moet blauw worden. Maar wat er gebeurd is dat alles vanaf de eerste rode font tot de laatste regel blauw wordt. Ook wordt dit dan naar het hoofdbestand gekopieerd, ook wanneer dit geen rode font heeft.

 

[wilcovanee]

Wilco,

@Warm bakkertje: Kun jij de fout reproduceren?
Ik heb je bestanden uitgebreid getest maar ik kan de fout niet reproduceren, bij loopt de macro tot het einde toe goed door.

Loopt er misschien nog een macro mee die reageert op het veranderen op wijzigingen in de werkmap of iets dergelijks.
Zo niet dan kan ik je vrees ik niet verder helpen.

Elsendoorn2134

Nee dit is de enige macro die draait. Krijg jij dan geen foutmelding bij regel 1500 en maakt hij deze netjes zwart? Hmmm, dan begrijp ik er niets meer van.