Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Pagina 2 van 2 EersteEerste 1 2
Weergeven resultaten 21 tot 33 van 33

Onderwerp: VBA - error 440

  1. #21
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    Het verplaatsen werkt nu met tussenvoegen inclusief formules in cellen en opmaak.
    Echter qua rijhoogtes zit het nog niet goed
    Onder het in te voegen gebied zijn een aantal rijen met een kleinere hoogte. Bij het runnen van het script komen de nieuwe rijen in dat gebied en hebben dan ook de kleinere hoogte.
    Dit vindt niet plaats bij het runnen van mijn code.

    Als ik de voorgestelde code vergelijk met de mijne in #1 wat is dan nog de "winst" ?
    Met dank en vriendelijke groet,
    Ton

  2. #22
    Giga Senior cow18's avatar
    Geregistreerd
    24 mei 2008
    Locatie
    Alveringem, België
    waarom is 1 van de vragen telkens een representatief voorbeeldje aan te maken.
    Andere optie, als die rijhoogte altijd een vaste waarde is, dan kan je dat ook zo opgeven.
    Opties zat.
    Code:
    Sub NieuweGegevens_Doorkopieren()
       kolommen = 12                                                '<------------------hoeveel kolommen wens je mee te nemen ???? nu 12, aanpassen !!!
    
       With Sheets("ImportRB")                                      'hier staan je nieuwe gegevens
          Set c0 = .Range("A8")                                     '--> je eerste cel linksboven met gegevens
          If Len(c0.Value) = 0 Then MsgBox "foutje bedankt": Exit Sub   'er er daar al niets staat, dan is het een foute boel
          With c0.CurrentRegion                                     'bereik rond die cel
             Set c1 = .Offset(8 - .Row).Resize(.Rows.Count - 8 + .Row, kolommen)   'vanaf je startcel zoveel rijen en 12 kolommen = bereik dat je straks wegschrijft naar "Bank"
          End With
       'MsgBox "door te kopieren gegevens staan in " & c1.Address
       End With
    
       With Sheets("Bank")
          Set c2 = .Range("A" & Rows.Count).End(xlUp)               'laatst gevulde A-cel, er wordt ingevoegd en gekopieerd op de cel eronder !!!
          If c2.Row < 6 Then Set c2 = .Range("A6")                  'minimaal vanaf A6
          If c2.Row > 1000 Then MsgBox "toch veel rijen dit jaar !!!" & vbLf & c2.Row, vbExclamation   'test op aantal rijen
       End With
    
       With c2                                                      'cel boven bereik waar je invoegt
          .Offset(1).Resize(c1.Rows.Count, kolommen).Insert xlDown  'zoveel lege rijen tussenvoegen als nodig
          c1.EntireRow.Copy                                         ' de hele rij kopieren
          .Offset(1).PasteSpecial xlPasteAll                        'met alles er op en er aan plakken
          c1.EntireRow.Delete                                       ' volledig wissen in ImportRB
       End With
    End Sub
    Bijgevoegde bestanden Bijgevoegde bestanden
    Laatst aangepast door cow18 : 7 september 2021 om 10:29

  3. #23
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    Nog een poging gedaan om een voorbeeldbestand te maken afgestemd op deze specifieke vraag.
    Bijgevoegde bestanden Bijgevoegde bestanden
    Met dank en vriendelijke groet,
    Ton

  4. #24
    Giga Senior cow18's avatar
    Geregistreerd
    24 mei 2008
    Locatie
    Alveringem, België
    via mijn macro (#22), licht gewijzigd om op het einde enkel de cellen met vaste inhoud (dus geen formules) te wissen heb ik de aanwezige gegevens in "ImportRB" naar "Bank" overgebracht.
    Op het eerste zicht lukt dat netjes, ook kwa rijhoogten.
    Er gebeurt wel van alles op de achtergrond, maar dat heb ik me niets van aangetrokken.
    Beter ?
    Bijgevoegde bestanden Bijgevoegde bestanden

  5. #25
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    Ik ben niet gauw tevreden
    1. De rijhoogte van de rode en groene lijn boven/onder de gele Saldo krijgen de standaard hoogte.
    Met mijn sub "Verplaatsen" (knop toegevoegd) gebeurt dat niet. Deze blijven smal. Vergelijk maak eens.
    2. Na het doorkopiëren moeten de rijen 8 e.v. leeg zijn om een volgende import goed te laten verlopen = deze rijen wissen bij doorkopiëren.

    Zou je willen aangeven voor een goed begrip wat het wezenlijke verschil is tussen de 2 oplossingsrichtingen - de jouwe en de mijne.
    Bijgevoegde bestanden Bijgevoegde bestanden
    Met dank en vriendelijke groet,
    Ton

  6. #26
    Giga Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Probeer eens niet vanuit de opmaak te denken. 1 tabel met waarin je de bankgegevens importeert en 1 tabel waarin je deze import toevoegt. Alle code die je hebt opgenomen is ontzettend inefficiënt. Het gebruik van call is nergens voor nodig.

    bv. ipv
    Code:
    Sub Naar_Laatste_Regel()                                        'Naar 1e lege regel
       Application.ScreenUpdating = False                           'Voorkomt flikkeren van het beeldscherm
    
       ActiveWindow.ScrollColumn = 1
    
       ActiveWorkbook.Worksheets("Bank").Select
       Dim lLaatsteRij As Long
       lLaatsteRij = Range("A5").End(xlDown).Row
       Rows("6:" & lLaatsteRij).Select
       Range("A" & [A1200].End(xlUp).Row + 1).Select                'cursor naar 1e lege cel van sheet Bank
       Selection.ClearContents
       ActiveWindow.ScrollRow = lLaatsteRij - Range("A2")           'flexibele LaatsteRij - aantal in cel A2
       ActiveWindow.SmallScroll ToRight:=-80
    
       Application.ScreenUpdating = True
    
    End Sub
    Code:
    Sub Naar_Laatste_Regel()                                        'Naar 1e lege regel
       Application.Goto Sheets("bank").Cells(Sheets("bank").Rows.Count, 1).End(xlUp).Offset(1)
    End Sub
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  7. #27
    Giga Senior cow18's avatar
    Geregistreerd
    24 mei 2008
    Locatie
    Alveringem, België
    ik keek ook tevreden naar jouw macro.
    Daar zit vermoedelijk vele jaren noeste arbeid en verbeteringen in.
    Vermoedelijk een handmatige papieren versie, die je zo 1-op-1 geautomatiseerd hebt
    Zo houden.

    Mijn 1e denkfout was dat ik niet altijd volledige rijen knipte of tussenvoegde.
    En mijn 2e, ik keek verbaasd op, met F8 stap per stap, dat bij de insert er ook al tegelijkertijd geplakt werd, een mens is nooit te oud om te leren.
    Dus succes.

  8. #28
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    De hele opzet is een groei van jaren. Eenvoudig begonnen en gegroeid en niet op de laatste plaats met gewaardeerde hulp van dit forum en hun enthousiaste deelnemers.
    Dat ik met 2 tabellen werk heeft te maken met de indeling van het te downloaden csv bestand en die ik wens te gebruiken.
    Het csv bestand krijgt de extensie .txt en mbv de wizard geïmporteerd in "RBImport"
    De kolomvolgorde, celopmaak, formules enz van het csv downloadbestand worden daarin gerealiseerd en vervolgens is de juiste kolomvolgorde celopmaak en formules verplaats/toegevoegd aan de verzameltabel.
    Je voorgestelde code voor gaan naar de eerste lege rij ga ik inzetten met een aanpassing om ook het zichtvenster naar wens te hebben.
    Code:
    Sub Naar_Laatste_Regel()        'Naar 1e lege regel
       Dim lLaatsteRij As Long
       lLaatsteRij = Range("A5").End(xlDown).Row
       Application.Goto Sheets("bank").Cells(Sheets("bank").Rows.Count, 1).End(xlUp).Offset(1)
       ActiveWindow.ScrollRow = lLaatsteRij - Range("A2")    'flexibele LaatsteRij - aantal in cel A2
       ActiveWindow.SmallScroll ToRight:=-80
    End Sub
    Met dank en vriendelijke groet,
    Ton

  9. #29
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    Quote Origineel gepost door cow18 Bekijk Bericht
    ik keek ook tevreden naar jouw macro.
    Daar zit vermoedelijk vele jaren noeste arbeid en verbeteringen in.
    Vermoedelijk een handmatige papieren versie, die je zo 1-op-1 geautomatiseerd hebt
    Zo houden.

    Mijn 1e denkfout was dat ik niet altijd volledige rijen knipte of tussenvoegde.
    En mijn 2e, ik keek verbaasd op, met F8 stap per stap, dat bij de insert er ook al tegelijkertijd geplakt werd, een mens is nooit te oud om te leren.
    Dus succes.
    Leuk om te vernemen en dan ook nog van een Giga Senior
    Inderdaad vele jaren try and error. Als hobby zonder enige IT opleiding op leeftijd veel uitdagingen opgepakt. Bij verandering van bank weer aanpassingen aan nieuwe downloadformaten enz.

    Heel veel dank voor al je inspanningen en suggesties

    De volgende uitdaging ligt al op de plank.
    Het routine voor detecteren van dubbelingen loopt alle rijen na van het hele jaar terwijl dat maar nodig is voor datums tussen de oudste en jongste datum van de import. Suggesties ?
    Code:
    Sub B06_Dubbelingen_VB()                                        'Dubbelingen markeren
       Application.ScreenUpdating = False
    
       ActiveWorkbook.Worksheets("Bank").Select
       Range("AJ4").Copy Destination:=Range("AJ6:AJ" & [A1200].End(xlUp).Row)
    
       'Dubbelingen verwijderen
       ActiveWorkbook.Worksheets("Bank").Select
       With Sheets("Bank")
          For i = .UsedRange.Rows.Count To 1 Step -1
             If IsNumeric(Left(.Cells(i, 36), 36)) Then             'de 36 staat voor de 36e kolom
                If (.Cells(i, 36).Value) = 2 Then .Cells(i, 36).EntireRow.Delete
             End If
          Next
       End With
    
       Range("b3:b" & [A1200].End(xlUp).Row).Name = "Cellenbereik"
       For Each cell In Range("Cellenbereik")
          If cell = "" Then cell.Offset(, 1) = cell.Offset(, 5).Value
       Next
    
       Call B_Opruimen
    
    End Sub
    Laatst aangepast door anton44 : 7 september 2021 om 19:20
    Met dank en vriendelijke groet,
    Ton

  10. #30
    Giga Senior cow18's avatar
    Geregistreerd
    24 mei 2008
    Locatie
    Alveringem, België
    Heel vriendelijk gezegd, het is een beetje industrieel erfgoed, mooi met kleurtjes en zo, maar heel fragiel, dus met de nodige voorzichtigheid te benaderen.

    verwijderen van duplicaten, daarvoor heeft excel een goeie functie en die noemt toevallig "verwijderen duplicaten".
    Daarbij ga je over het gehele bereik de gewenste kolommen specifiëren waarop gecheckt moet worden en van zodra er toch een verschil is, dan blijft die rij staan.
    Hier wilde je enkel verschillen checken op kolom 35, maar het kan nog strenger.
    Code:
    Sub Verwijder_Duplicaten()
       Dim LinksBoven
    
       With Sheets("bank")
          Set LinksBoven = .Range("A5")                             'cel linksboven in je bereik
          rijen = .Range("A" & Rows.Count).End(xlUp).Row - LinksBoven.Row + 1   'aantal rijen inclusief koprij
       'vanaf cel "linksboven" kijk je zoveel rijen diep en 37 kolommen breed en verwijder je alle duplicaten die zowel verschillen in de 1e, 2e, .... kolom
          LinksBoven.Resize(rijen, 37).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 35, 36, 37), Header:=xlYes
          End With
    End Sub
    deze is veel strenger dan jouw versie die ongeveer deze is
    LinksBoven.Resize(rijen, 37).RemoveDuplicates Columns:=35, Header:=xlYes
    in die lijst van rode cijfertjes verwijder je gewoon de kolommen waar niet moet naar gekeken worden.

    Gevaar, ook hier weer, aangezien er een deel van een rij verwijderd wordt, vrees ik weer voor de rijhoogten er onder.
    Dus, in dat geval, hou ik er liever mee op.
    Als je, door esthetische bezwaren, de gewone functies niet meer kan gebruiken, dan moet je dat veranderen, niet omgekeerd.
    Laatst aangepast door cow18 : 8 september 2021 om 08:56

  11. #31
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    De strengheid is met kolom 35 gewaarborgd. Het is een samenvoeging van de datum en dagvolgnummer.
    Dubbelingen kunnen alleen voorkomen in de rijen die door het doorkopiëren/verplaatsen toegevoegd zijn in "Bank"
    Het doorzoeken van waarde 2 in kolom 36 hoeft dus alleen maar plaats te vinden in dat bereik en niet over de tig aantal andere rijen.
    Ik zoek dus een oplossing die de iteratieloop in kolom 36 beperkt (code regel 30)
    Code:
    ' deel van code
     20  With Sheets("Bank")
     25     For i = .UsedRange.Rows.Count To 1 Step -1
     30        If IsNumeric(Left(.Cells(i, 36), 36)) Then             'de 36 staat voor de 36e kolom
     35          If (.Cells(i, 36).Value) = 2 Then .Cells(i, 36).EntireRow.Delete
     40        End If
     45     Next
     50  End With
    Bijgevoegde bestanden Bijgevoegde bestanden
    Laatst aangepast door anton44 : 8 september 2021 om 10:22
    Met dank en vriendelijke groet,
    Ton

  12. #32
    Giga Senior cow18's avatar
    Geregistreerd
    24 mei 2008
    Locatie
    Alveringem, België
    sorry, vanaf hier pas ik.
    - Regel 25, verander die dat je pas vanaf je "laatste rij" naar boven gaat en niet vanaf het einde van je "UsedRange"
    - regel 30 is bull**** (het stuk waar je het linker deel afvraagt)
    - regel 35, daar zou ik ">=2" gebruiken ipv. "=2"

  13. #33
    Mega Senior
    Verenigingslid
    anton44's avatar
    Geregistreerd
    20 mei 2005
    Locatie
    ergens in Midden Limburg
    Quote Origineel gepost door cow18 Bekijk Bericht
    sorry, vanaf hier pas ik.
    - Regel 25, verander die dat je pas vanaf je "laatste rij" naar boven gaat en niet vanaf het einde van je "UsedRange"
    - regel 30 is bull**** (het stuk waar je het linker deel afvraagt)
    - regel 35, daar zou ik ">=2" gebruiken ipv. "=2"
    Passen? Kan ik me voorstellen
    Nogmaals dank voor je inspanningen.
    Met dank en vriendelijke groet,
    Ton

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl

Regels
Help

Helpmij.nl en business

Partners
Sponsoren