Kolommen naar regels

Forumregels
In dit forum geen vragen stellen, het is uitsluitend bedoeld voor het plaatsten en toelichten van code. Stel vragen in het forum Macro's.
fireman
Berichten: 6
Lid geworden op: za okt 30, 2010 2:40 pm

Kolommen naar regels

Bericht door fireman »

Hallo,
Hierbij een macro om kolommen naar regels om te zetten.
Deze macro kopieert alleen de waarden van de cellen.
Je kunt hem aanpassen aan je eigen behoefte.

Code: Selecteer alles

Sub ColumnsToRows
Dim Document as object, Sheet1 as object, Sheet2 as object, Cell1 as object, Cell2 as object 
Dim Item as string, Column1 as integer, Column2 as integer, Row1 as integer, Row2 as integer, EmptyRows as integer 

Document = ThisComponent 
Sheet1 = Document.Sheets.getByIndex(0)   'if you want to change the sheet where the information is, change this number (0 = Sheet1, 1 = Sheet2, 2 = Sheet3, ...) 
Sheet2 = Document.Sheets.getByIndex(1)   'if you want to change the sheet where the information is written to, change this number (like above) 

Column1 = 0   'if you want to read from another column, then change this number (0 = column A, 1 = column B, 2 = column C, ...) 
Column2 = 0    'if you want to start writing from another column, then change this number (like above) 
Row1 = 0   'if you want to start reading from another row, then change this number (0 = row 1, 1 = row 2, 2 = row 3, ...) 
Row2 = 0   'if you want to start writing from another row, then change this number (like above) 
EmptyRows = 0 

While EmptyRows < 3   'loop stops after 3 consecutive empty rows 
   Cell1 = Sheet1.getCellByPosition(Column1,Row1) 
   Item = Cell1.getString() 

   if (Item = "") then 
      EmptyRows = EmptyRows + 1 
      Column2 = 0 
      if (EmptyRows = 2) then 
         'two consecutive empty rows 
      else 
         Row2 = Row2 + 1 
      endif 
   else 
      EmptyRows = 0 
      Cell2 = Sheet2.getCellByPosition(Column2, Row2) 
      Cell2.setString(Item) 
      Column2 = Column2 + 1 
   endif 

   Row1 = Row1 + 1 
wend 

MsgBox("Loop stopped at row: " + Row1) 
End Sub
Open office 3.1
Windows 7
RPG
Berichten: 4667
Lid geworden op: wo apr 15, 2009 1:01 am
Locatie: Apeldoorn, Nederland

Re: Kolommen naar regels

Bericht door RPG »

Hallo

Dit is niet bedoeld als vraag maar als opmerking.
Ik vraag mij af wat het voordeel van deze macro is boven een ingebouwde functie zoals
transpose.

Als het een eenmalige actie je kunt het ook laten doen bij kopieren en plakken in de extra mogelijkheden bij plakken.

Romke
LibreOffice 7.4.3.2 op openSUSE Leap 15.4
Plaats reactie