Select verminderen

[TonRo]

Geachte kenners,

Ik ben een macro aan het maken waarbij ik eerst een range selecteer in een sheet.
Iedere waarde in de selectie moet gezocht worden.

In een andere sheet ga ik op iedere waarde filteren.
De data die dan zichtbaar wordt moet geheel geselecteerd worden en gecopieerd naar een andere sheet onder aansluitend aan de al bestaande data.

Mijn macro werkt, maar om 1000 waarden te doen is hij ± een half uur bezig. Aangezien ik 87000 waarden moet doen gaat dit ruim 40 uur lopen.
Iedere regel sluit ik zowat met select. Dus dit werkt vertragend.

Ik heb op verschillende plaatsen gezien dat je selecteren zoveel mogelijk moet voorkomen en dit lukt me gedeeltelijk.
Alleen op het moment dat ik met XLenddown en XLendup ga werken loopt mijn macro vast.

Kan iemand eens naar mijn trage code kijken en hem mogelijk aanpassen.

Sub Macro2()
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Z = Time
    
    Sheets("Straatnamen2").Select
    Range("C3401:C4400").Select
Rem    Range(Selection, Selection.End(xlDown)).Select
    For Each Cell In Selection
        a = Cell.Value
        Sheets("Postcodes").Select
        ActiveSheet.ListObjects("Tabel_Postcodes1").Range.AutoFilter Field:=4, _
            Criteria1:=a
        Range("A1").Select
        Selection.Offset(1, 0).Select
        Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.Copy
        Sheets("Postcodes2").Select
        Range("A1").Select
        Selection.End(xlDown).Select
        Selection.End(xlDown).Select
        Selection.End(xlUp).Select
        Selection.Offset(1, 0).Select
        ActiveSheet.Paste
        Sheets("Straatnamen2").Select
    Next
    
    y = Time
    
    MsgBox ("Klaar, " & "de starttijd = " & Z & " de eindtijd = " & y)
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub

De code na REM was eerst bedoeld om alle waarden ±87000 stuks in een keer te doen, maar dit liep dus veel te lang.

Hopelijk lukt het iemand van jullie.

Alvast bedankt

TonRo

 

[snb]

Ik zocht eerst nog even naar je voorbeeldbestand....

 

[TonRo]

Hallo snb,

Sorry dat ik nu pas reageer, ben net thuis van mijn werk.

Ik zal kijken wat ik kan doen, bestand is 70MB groot. Mogelijk kan ik een gedeelte doorsturen zodat je kunt zien wat de bedoeling is.

Mogelijk lukt dit pas morgenvroeg.

Gr TonRo

 

[Warme bakkertje]

Bij wijze van test.

Sub Macro2()
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    Z = Time
    For Each Cl In Sheets("Straatnamen2").Range("C3401:C" & Sheets("Straatnamen2").Cells(Rows.Count, 3).End(xlUp).Row)
        With Sheets("Postcodes")
            .AutoFilterMode = False
            .ListObjects("Tabel_Postcodes1").Range.AutoFilter 4, Cl.Value
            .AutoFilter.Range.Offset(1).SpecialCells(xlVisible).Copy _
                    Sheets("Postcodes2").Range("A" & Sheets("Postcodes2").Rows.Count).End(xlUp).Offset(1)
            .ShowAllData
        End With
    Next
    y = Time
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    MsgBox ("Klaar, " & "de starttijd = " & Z & " de eindtijd = " & y)
End Sub

 

[snb]

ik zou eerder alles in een array zetten en zeker geen autofilter gebruiken om 1 waarde te zoeken, maar range().find

 

[TonRo]

Hallo Rudi en snb,

Allereerst wat de code van Rudi betreft, deze loopt ± 25 min als ik 1000 regels doe.

Ik had in eerste instantie per ongeluk de macro opgestart en deze heeft toen 2.5 uur gelopen. Toen moest ik gaan werken en heb ik de zaak onderbroken en was dus alles voor niets. gisteravond heb ik het geprobeerd met 1000 regels en dan is er wel wat tijd winst maar toch niet veel. Al vind ik de code wel heel leerzaam.

Wat snb betreft weet ik niet wat er bedoeld wordt met een array en wat hier de winst van kan zijn.
Ik heb enkele uren besteedt om het bestand kleiner te krijgen en het maximum wat ik behaald heb is van 70 naar nu 10MB maar dit is nog veel te groot.

Het betreft een bestand met de postcode's van heel nederland. Dit is 70MB groot. Ik wil maar drie provincies gebruiken en probeer daarom uit de hele grote lijst de provincies uit te selecteren.

Ik weet nu even niet wat ik moet doen, mogelijk kan ik het bestand vanuit een andere sheet benaderen. Dan mag hij van mij wel zo groot blijven en hoeft de andere macro niet te lopen.

Ik ga dit uitproberen.

Jullie in elk geval al bedankt voor het meedenken en misschien dat jullie toch nog een manier weten om dit snel te laten verlopen, dan vindt ik het nog steeds de beste oplossing.

Gr TonRo

 

[Warme bakkertje]

Een voorbeeldbestand hoeft echt niet zo groot te zijn.
Maak 1 werkblad met een 10-tal rijen met op te zoeken waarden, een 2de werkblad met bv een 100-tal rijen waarin gezocht moet worden (of minder als het bestand te groot wordt) en een derde werkblad met het resultaat van je opzoeking.
De bedoeling is enkel om een algemeen beeld te krijgen van de opbouw en layout van je bestand en het beoogde resultaat.
Mijn macro was ook geen directe oplossing voor je probleem doch echter meer om het programmeren zonder Select te verduidelijken.
Wat snb bedoelt is dat je alles in een lijst in het werkgeheugen inleest, daar de opzoekingen uitvoert en het resultaat in 1 keer naar je resultaatblad schrijft.
Bewerkingen in het werkgeheugen gaat 10-tallen keren sneller dan lees-en schrijfbewerkingen op je werkblad.

 

[TonRo]

Hallo Rudi en snb,

Allereerst sorry dat het even geduurd heeft maar ik heb niet eerder tijd gehad om er iets aan te doen.

Eindelijk is het me toch geluk om het bestand wat te verkleinen.

Er zat iets in het originele bestand waardoor hij steeds groot bleef, ik vermoed iets met de opmaak of wat dan ook.
In elk geval kon ik het niet vinden en bleef ik op ong. 10MB hangen.

Nu heb ik gegevens gecopieerd en alleen de waarden geplakt.

Hopelijk willen jullie er nog eens naar kijken.

Houd er wel rekening mee dat de 10 regels die nu op sheet straatnamen2 staat in het originele bestand uit ong. 87000 regels bestaat.

Gr TonRoBekijk bijlage helpmij.xlsm

 

[Warme bakkertje]

Ziehier mijn poging.
Aangezien er een beperking is van 65536 rijen in een array heb ik het zoeken moeten opsplitsen in blokken van 10.000 rijen. Je moet dus in de rangeArr bij het laatste element de laatste rij wijzigen (waar nu 87001 staat).Ik zal eens verder zoeken naar een meer elegante oplossing maar dan kan je nu voorlopig testen. Je zou eventueel het opsplitsen ook kunnen vergroten naar blokken van 15000 rijen om het sneller te laten verlopen (minder schrijfbewerkingen naar het werkblad), maar om oversize te vermijden heb ik een veiligheidsmarge ingecalculeerd.
Bij mijn test op 87000 opzoekingen kwam ik uit op 16,5 sec en werden er 295000 resultaten weggeschreven. Het zal bij jou uiteraard meer vergen aangezien jouw zoekmatrix veel groter is dan de 140 rijen op blad Postcodes in jouw voorbeeldbestand, maar ik denk niet dat we aan 40 uur gaan uitkomen.:d
Test het eens uit en laat dan maar iets weten.

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub Opzoeken()
    lstart = timeGetTime
    Application.ScreenUpdating = False
    sourceArr = Sheets("Postcodes").Range("A2:E" & Sheets("Postcodes").Cells(Rows.Count, 5).End(xlUp).Row)
    rangeArr = Array("C2:C10000", "C10001:C20000", "C20001:C30000", "C30001:C40000", "C40001:C50000", _
                            "C50001:C60000", "C60001:C70000", "C70001:C80000", "C80001:C87001")
    For Each it In rangeArr
    sn = Sheets("Straatnamen2").Range(it)
    ReDim temparray(1 To 5, 1 To 1) As Variant
    On Error Resume Next
    For i = 1 To UBound(sn)
        For outerindex = 1 To UBound(sourceArr, 1)
            If sourceArr(outerindex, 4) = CStr(sn(i, 1)) Then
                tempArrayIndex = tempArrayIndex + 1
                ReDim Preserve temparray(1 To 5, 1 To tempArrayIndex)
                For innerIndex = 1 To 5
                    temparray(innerIndex, tempArrayIndex) = sourceArr(outerindex, innerIndex)
                Next
            End If
        Next
    Next
    With Sheets("Postcodes2")
        .Range("A" & .Rows.Count).End(xlUp).Offset(1).Resize(tempArrayIndex, 5) = Application.Transpose(temparray)
    End With
    tempArrayIndex = 0
    Next
    Application.ScreenUpdating = True
    lend = timeGetTime
    MsgBox (lend - lstart) / 1000 & "Sec."
End Sub

 

[TonRo]

Hallo warme bakkertje,

Allereerst bedankt voor je reactie. Je code ziet er geweldig uit en ik begrijp de helft van de codering niet.

Hij werkt wel alleen op een test van 10000 regels was hij ruim 2,5 uur bezig, dus in totaal zal het op ong. 22 uur uitkomen om alles te doen.

Ik ga nog even kijken of ik je codering kan begrijpen. Ik kan er altijd van leren.

Ik denk dat het niet veel sneller kan. Misschien moet ik het op een andere manier doen.

Ik zou door sorteren mogelijk ook de juiste rijen er tussen uit kunnen halen, maar ik wou het graag met VBA proberen.

Gr TonRo

 

[Warme bakkertje]

Uit hoeveel rijen bestaat je postcode werkblad dan, dus het werkblad waarin gezocht moet worden ?
Is dit bestand zelf samengesteld of kan het ergens gedownload worden zodat ik met de volledige zoekgegevens kan testen ?
Het resultaat is uiteraard ook afhankelijk v/d machine waarop gewerkt wordt o.a beschikbaar geheugen enz.

PS een andere manier om je bestand te verkleinen is op elk werkblad alle rijen na de laatstgevulde rij te selecteren, rechtsklikken op het geselecteerde gebied en Verwijderen kiezen.
Doe hetzelfde met de kolommen. Sla daarna je bestand op en sluit het af.
Dit zou een verschil kunnen maken aangezien nu alle opmaak e.d. verwijdert is uit de nietgebruikte gebieden.

 

[TonRo]

Hallo Rudi,

Het postcode werkblad bestaat uit 625573 rijen.

Ik heb het bestand via een collega die het van een of andere nieuwsbrief als access bestand gedownload heeft, maar ik weet niet waar vandaan.

Hij heeft het mij op een usbstick aangeleverd. Ik zal eens proberen of ik wat opmaak kan verwijderen.

Alvast weer bedankt.

Gr TonRo

 

[Warme bakkertje]

Dat geeft dan 54.424.851.000 zoekbewerkingen.
Ik denk dat je vraag om snelheid daarmee opgelost is.
De enige voldoening die ik hier dan kan uithalen is dat ik de zoektijd al heb kunnen halveren (nog slechts 20 uur)

 

[TonRo]

Hallo Rudi,

Ik denk dat ik je gelijk moet geven en moet onderkennen dat ik iets wil wat eigenlijk niet te doen is.

Toch bedankt dat je hebt willen meedenken en ik blijf het knap vinden hoe je de codering samenstelt, ik kan hier veel van leren.

Ik ga maar een andere manier proberen om de data te splitsen.

Nogmaals bedankt.

Gr TonRo

 

[Warme bakkertje]

Beste TonRo,
Ik heb de hele thread eens terug doorgelezen en je stelt dat de grote lijst alle postcodes (lees alle provincies) van Nederland bevat en je er slechts drie nodig hebt.
Waar ik aan denk is een unieke lijst aanleggen met alle beginnummers (lees meest linkse cijfer) van de op te zoeken waarden. Met deze unieke lijst kunnen we dan van die hele grote lijst een kleinere uitfilteren op basis van die beginnummers zodat we een kleinere zoekmatrix bekomen.
Op die manier zou het aantal zoekbewerkingen kunnen verminderd worden wat dan weer tijdswinst zou kunnen opleveren.
Over hoeveel tijdswinst kan ik me niet uitspreken en je mag je er niet op blindstaren want het blijft een serieuze zoekmachine maar het is het proberen waard.

 

[TonRo]

Hallo Rudi,

Ik begreep niet precies hoe je het vorige bedoelde, maar terwijl ik wat dingen probeerde kwam ik erachter dat er een verband zat in de nummering per provincie.

Ik heb dit verder uitgewerkt en door middel van sorteren en het gedeeltelijk verwijderen van gegevens van andere provincies heb ik mijn gegevens nu goed.

Alleen het bestand is nog wel 8 MB groot, maar ja je hebt dan ook veel data.

Ik denk dat wat ik eigenlijk vroeg niet te doen was met zoveel data, maar wil je toch bedanken voor de opties die je aangedragen hebt.

Ik heb er zeker wat van opgestoken.

Gr, TonRo