Stappen in macro herhalen

[Tcgielo]

Hoi allen,

Ik heb een macro opgenomen om een exportbestand om te zetten zodat orderregels goed onder elkaar komen te staan.
Deze zou ik graag willen aanpassen zodat de stappen voor iedere regel wordt herhaald waardoor ik niet handmatig de code hoef aan te passen tot een x aantal mogelijke regels (kunnen er veel zijn, dus code zou dan heel lang worden en het is veel werk).

Onderstaand de code. In eerste instantie zet ik de kopregel en de 1e orderregel goed neer. Vervolgens komen daaronder alle volgende orderregels, waarbij bij iedere orderregel de stap feitelijk hetzelfde is, maar dan een regel lager. Dus het stuk code onder ---orderregels--- zou ik graag herhalend willen maken.

Is dit mogelijk?

Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Columns("B:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D4:E5").Select
Range("D4:E5").Cut Destination:=Range("D1:E2")
Range("F4:G5").Select
Selection.Cut Destination:=Range("B1:C2")
-----------Hierboven is goedzetten van kopregel en 1e orderregel---

---Orderregels---
--2--
Range("D9:E10").Select
Selection.Cut Destination:=Range("D6:E7")
Range("F9:G10").Select
Selection.Cut Destination:=Range("B6:C7")
Rows("3:6").Select
Selection.Delete Shift:=xlUp

--3--
Range("D10:E11").Select
Selection.Cut Destination:=Range("D7:E8")
Range("F10:G11").Select
Selection.Cut Destination:=Range("B7:C8")
Rows("4:7").Select
Selection.Delete Shift:=xlUp

--4--
Range("D11:E12").Select
Selection.Cut Destination:=Range("D8:E9")
Range("F11:G12").Select
Selection.Cut Destination:=Range("B8:C9")
Rows("5:8").Select
Selection.Delete Shift:=xlUp
End Sub

 

[edmoor]

Zet hier je code in code tags en plaats een voorbeeld bestandje.

 

[Tcgielo]

Hoi Edmoor,

Weet niet helemaal zeker hoe ik de code juist in tags zet zoals je schrijft, maar heb een poging gedaan.
Daarnaast een voorbeeldbestand in de bijlage toegevoegd

Sub Test()
'
' Test Macro
'

'
Columns("A:K").Select
Columns("A:K").EntireColumn.AutoFit
Rows("1:4").Select
Selection.Delete Shift:=xlUp
Columns("B:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("D4:E5").Select
Range("D4:E5").Cut Destination:=Range("D1:E2")
Range("F4:G5").Select
Selection.Cut Destination:=Range("B1:C2")
-----------Hierboven is goedzetten van kopregel en 1e orderregel---

---Orderregels---
--2--
Range("D9:E10").Select
Selection.Cut Destination:=Range("D6:E7")
Range("F9:G10").Select
Selection.Cut Destination:=Range("B6:C7")
Rows("3:6").Select
Selection.Delete Shift:=xlUp

--3--
Range("D10:E11").Select
Selection.Cut Destination:=Range("D7:E8")
Range("F10:G11").Select
Selection.Cut Destination:=Range("B7:C8")
Rows("4:7").Select
Selection.Delete Shift:=xlUp

--4--
Range("D11:E12").Select
Selection.Cut Destination:=Range("D8:E9")
Range("F11:G12").Select
Selection.Cut Destination:=Range("B8:C9")
Rows("5:8").Select
Selection.Delete Shift:=xlUp
End Sub

 

[edmoor]

Die bijlage is geen Excel document maar een CSV bestand.
Die krijg je op die manier aangeleverd?

 

[snb]

CSV bestand geopend in Excel.
Deze macro gedraaid; verdraaid !:

Sub M_snb()
  For Each it In Sheet1.Columns(1).SpecialCells(4).Areas
    If it.Cells(1).Row = 7 Then it.Cells(2).Offset(, 1).Resize(, 4).Copy it.Cells(1).Offset(-2, 10)
    it.Cells(3).Offset(, 1).Resize(, 4).Copy it.Cells(1).Offset(-1, 10)
  Next
  Columns(1).Replace " ", ""
  Sheet1.Columns(1).SpecialCells(4).EntireRow.Delete
End Sub

 

[Tcgielo]

Hoi Snb,

Dank voor je bijdrage!
Ik krijg een foutmelding als ik hem uitvoer (zie bijlages), wat doe ik fout?

 

[Tcgielo]

Hoi Edmoor,

Ik krijg het inderdaad als CSV bestand op deze wijze aangeleverd.

 

[snb]

Jouw werkblad heeft blijkbaar een andere codenaam dan 'sheet1'.
Pas de code daarop aan.

 

[Tcgielo]

Hoi Snb,

Het moest blijkbaar Blad1 zijn, het werkt!
Super bedankt!

Kleine additionele vraag nog; hoe kan de code worden uitgebreid om het huidige datumformat in StartDateTime en EndDateTime naar DD-MM-YYYY aan te passen?
Dit is nu bijvoorbeeld; 2022-10-18T12:00:00, en zou dan 18-10-2022 moeten worden.

 

[snb]

celopmaak aanpassen ?

 

[Tcgielo]

Hoi Snb,

Omdat het format "2022-10-18T12:00:00" is kan ik hier niet standaard een datumopmaak van maken, ik vermoed vanwege de 'T' die tussen datum en tijd in staat. Hoe zou ik in de code kunnen opnemen dat het stuk achter YYYY-MM-DD weg wordt gehaald?

Verder krijg ik opeens de foutmelding:
1004 'Er zijn geen cellen gevonden'

Terwijl ik exact jouw code uitvoer op het voorbeeldbestand (enige verschil is wijziging van sheet1 naar blad1 ivm de objectfoutmelding eerder). Zou je hier een oplossingsrichting weten?

Dank is wederom groot!

 

[snb]

Kijk eens naar de code regel 4
Als je weet wat die doet kun je zelf een regel toevoegen die de T in de kolom met datum/tijd verwijdert.

 

[Tcgielo]

Hoi Snb,

Ik ben in een aparte macro aan het testen met de code om de T te verwijderen.

Ik krijg alleen in het origineel nog steeds dezelfde foutmelding bij het uitvoeren van jouw code: 'Er zijn geen cellen gevonden'
Terwijl ik exact jouw code uitvoer op het voorbeeldbestand (enige verschil is wijziging van sheet1 naar blad1 ivm de objectfoutmelding eerder. Zou je hier een oplossingsrichting weten?

 

[snb]

Ik kan niet in jouw bestanden kijken.
Je voorbeeldbestand was dan blijkbaar niet representatief/analoog.

 

[Tcgielo]

Dag Snb,

Het vreemde is dat ik ook dezelfde melding 'er zijn geen cellen gevonden' krijg op het voorbeeldbestand, terwijl de code het in eerste instantie wel deed.
Enige aanpassing op jouw code is sheet1 --> blad1. Ik vind op andere forumdraadjes nog niet de oplossing hiervoor.

Zoals je al wel kan merken ben ik met betrekking tot VBA een beginner