• 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.

Gegevens verplaatsen en vervangen o.b.v. waarde middels VBA

Status
Niet open voor verdere reacties.

Paradoxx

Gebruiker
Lid geworden
2 nov 2007
Berichten
135
Goedemiddag,

vanwege een fout in antiek bronbestand (OPG file, vaste breedte) ben ik op zoek naar een manier om gegevens te verplaatsen naar de juiste kolommen en bepaalde waardes welke aan gestelde voorwaarden voldoen, te wijzigen. Bijgaand een voorbeeld bestand ontdaan van overbodige informatie en persoongegevens.

Het originele bestand converteer ik al naar een csv indeling welke ons ERP programma kan inlezen. Dit originele bestand beslaat ca 150 kolommen met gegevens met meer dan 10.000 regels. Ik blijf even in kolomnrs praten (staan in regel 1 genoemd)

Voor elke regel; op basis van de waarde in kolom nr 18 (kolom O in het voorbeeld bestand) moeten er achtereenvolgens de volgende handelingen plaatsvinden wanneer de waarde in Kolomnr 18 "0" is (cijfer nul)
  • waarde kolom 19 knippen en plakken in kolom 20
  • waarde kolom 26 knippen en plakken in kolom 27
  • als waarde in kolom 145 groter dan 0, kopieer die waarde naar kolom 18
  • als waarde in kolom 145 = 0, dan kolom 18 vullen met waarde "0,01"
Volgende regel

Ik ben een beginner met VBA, en zit te spelen met een For Each lus, maar kan niet de code verzinnen die bovenstaande mogelijk maakt. Kan iemand mij op weg helpen?
 

Bijlagen

  • NAK file.xlsx
    11,7 KB · Weergaven: 17
Zelf maar even de juiste kolomnummers in vullen want dat is niet te testen in het bestand.

Code:
Sub VenA()
ar = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    If ar(j, 15) = 0 Then
      ar(j, 17) = ar(j, 16)
      ar(j, 16) = ""
      ar(j, 19) = ar(j, 18)
      ar(j, 18) = ""
      ar(j, 18) = IIf(ar(j, 21) = 0, 0.01, ar(j, 21))
    End If
  Next j
  Sheets("Blad1").Cells(32, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
End Sub
 
Bedankt voor de code. Ik zal hem morgenvroeg gelijk even uitproberen...
 
Zelf maar even de juiste kolomnummers in vullen want dat is niet te testen in het bestand.

Code:
Sub VenA()
ar = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    If ar(j, 15) = 0 Then
      ar(j, 17) = ar(j, 16)
      ar(j, 16) = ""
      ar(j, 19) = ar(j, 18)
      ar(j, 18) = ""
      ar(j, 18) = IIf(ar(j, 21) = 0, 0.01, ar(j, 21))
    End If
  Next j
  Sheets("Blad1").Cells(32, 1).Resize(UBound(ar), UBound(ar, 2)) = ar
End Sub

Ik heb hem aangepast naar de juiste kolomnummers en gestart. Het werkt als een zonnetje! Ik begrijp alleen UBound niet helemaal, maar die zoek ik nog wel even op.
Wat ik me nog wel even afvraag is het volgende. Je zet een kopie van de gecontroleerde regels in de aangepaste vorm onder de originele regels. Kan ik dit ook op de originele regels zetten?
Of moet ik gewoon even een extra tabblad daarvoor gebruiken? Ik had in het voorbeeld bestand het gewenste resultaat ter illustratie er onder geplaatst. Het echte bestand is namelijk ruim 10.000 regels groot.
 
Een heel bericht quoten is niet nodig. Je kan de waarden uit een array op elke willekeurige plaats wegschrijven. Even simpel gesteld Ubound(ar) of Ubound(ar,1) is het aantal rijen en Ubound(ar,2) het aantal kolommen in de array. Voor meer info zie http://www.snb-vba.eu/VBA_Arrays_en.html#L_0

Zo worden de gegevens overschreven:
Code:
Sub VenA()
  ar = Sheets("Blad1").Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    If ar(j, 15) = 0 Then
      ar(j, 17) = ar(j, 16)
      ar(j, 16) = ""
      ar(j, 19) = ar(j, 18)
      ar(j, 18) = ""
      ar(j, 18) = IIf(ar(j, 21) = 0, 0.01, ar(j, 21))
    End If
  Next j
  Sheets("Blad1").Cells(1).CurrentRegion = ar
End Sub
 
VenA,

bedankt voor de hulp. Ik heb het even aangepast en het werkt goed nu. :thumb:
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan