• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA - error 440

Status
Niet open voor verdere reacties.
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" ?
 
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

   [COLOR="#FF0000"]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[/COLOR]
End Sub
 

Bijlagen

  • Anton.xlsm
    43,5 KB · Weergaven: 7
Laatst bewerkt:
Nog een poging gedaan om een voorbeeldbestand te maken afgestemd op deze specifieke vraag.
 

Bijlagen

  • Bankieren Voorb 2021.xlsm
    873,2 KB · Weergaven: 10
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 ?
 

Bijlagen

  • Bankieren Voorb 2021 (1).xlsm
    880,2 KB · Weergaven: 5
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.
 

Bijlagen

  • Bankieren Voorb_ versie 2 2021.xlsm
    871,8 KB · Weergaven: 66
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
 
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.
 
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
 
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 :thumb:

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 bewerkt:
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 [COLOR="#FF0000"]Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 35, 36, 37)[/COLOR], 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 bewerkt:
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
 

Bijlagen

  • Bankieren Voorb_ versie 4 2021.xlsm
    849,6 KB · Weergaven: 10
Laatst bewerkt:
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"
 
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.:thumb:
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan