[Solved] Merge/allign cells in Columns macro

Creating a macro - Writing a Script - Using the API

[Solved] Merge/allign cells in Columns macro

Postby marcobernardo » Tue Mar 22, 2016 3:23 pm

Hi everyone,

How can I merge automatically cells that are in different columns to be in the right Columns?

Regards,
Marco
Attachments
Merge_allign_cells_shiftleft.ods
Example Sheet
(10.43 KiB) Downloaded 64 times
Last edited by marcobernardo on Thu Mar 24, 2016 12:20 am, edited 1 time in total.
Open Office 4.1.1, OSX 10.11.2
marcobernardo
 
Posts: 8
Joined: Tue Mar 22, 2016 2:30 pm

Re: Merge/allign cells in Columns macro

Postby B Marcelly » Wed Mar 23, 2016 10:54 am

What do you want to achieve ?
As an example, write in sheet2 of the document the result you want.
Bernard

OpenOffice.org 1.1.5 / Apache OpenOffice 4.1.1 / LibreOffice 5.0.5
MS-Windows 7 Home SP1
B Marcelly
Volunteer
 
Posts: 1160
Joined: Mon Oct 08, 2007 1:26 am
Location: France, Paris area

Re: Merge/allign cells in Columns macro

Postby Zizi64 » Wed Mar 23, 2016 11:29 am

The data in your example file seems as imported textual format 'Time values' from a text (TSV) file, with multiple separator (delimiter) characters. (TABs for example.) You can merge delimiters when you import the data.
Tibor Kovacs, Hungary; LO6.1.6 on Win7-10 x64Prof.
PortableApps, winPenPack: LO3.3.0-6.2.8; AOO4.1.6
Please, edit the initial post in the topic: add the word [Solved] at the beginning of the subject line - if your problem has been solved.
User avatar
Zizi64
Volunteer
 
Posts: 8375
Joined: Wed May 26, 2010 7:55 am
Location: Budapest, Hungary

Re: Merge/allign cells in Columns macro

Postby marcobernardo » Wed Mar 23, 2016 12:52 pm

B Marcelly wrote:What do you want to achieve ?
As an example, write in sheet2 of the document the result you want.


HI Bernard,
Here is the final result I like to achieve if possible.

Zizi64 wrote:The data in your example file seems as imported textual format 'Time values' from a text (TSV) file, with multiple separator (delimiter) characters. (TABs for example.) You can merge delimiters when you import the data.


You're right, but the file as more data, and if I use delimiters it will put in the same row and cell other type of data :(

Thank you so much for help me out.
Attachments
Merge_allign_cells_shiftleft_edited.ods
final result to achieve
(11.7 KiB) Downloaded 48 times
Open Office 4.1.1, OSX 10.11.2
marcobernardo
 
Posts: 8
Joined: Tue Mar 22, 2016 2:30 pm

Re: Merge/allign cells in Columns macro

Postby B Marcelly » Wed Mar 23, 2016 3:48 pm

Here is a solution.
Align_cells_AtLeft.ods
Example with code
(11.53 KiB) Downloaded 46 times

Somewhere in columns D to L, it is expected to find 4 data in succession.
Empty lines are skipped.
Adapt to your needs.
Code: Select all   Expand viewCollapse view
Option Explicit

Sub AlignToColumnLeft
Dim sh As Object, zone As Object, dataRow As Variant
Dim y As Long, x1 As Long, x2 As Long
Const minCol = 3, maxCol = 11 ' columns D to L contain data
Const nbrOfValues = 4

sh = ThisComponent.Sheets.getByName("Sheet1")

for y = 0 to 100 ' from row 1 to row 101 (example)
  zone = sh.getCellRangeByPosition(minCol, y, maxCol, y)
  dataRow = zone.DataArray
  dataRow = dataRow(0) ' get the list of data
  x1 = 0
  Do While Len(dataRow(x1)) = 0
    x1 = x1 +1
    if x1 > UBound(dataRow)  then exit do ' no data in this line
  Loop
  if (x1 > 0) and (x1 <= UBound(dataRow))  then
    for x2 = 0 to nbrOfValues -1 ' move data to left
      dataRow(x2) = dataRow(x2 +x1)
    next
    for x2 = nbrOfValues to UBound(dataRow) ' clear the rest
      dataRow(x2) = ""
    next
    zone.dataArray = Array(dataRow)
  end if
next
End Sub
Bernard

OpenOffice.org 1.1.5 / Apache OpenOffice 4.1.1 / LibreOffice 5.0.5
MS-Windows 7 Home SP1
B Marcelly
Volunteer
 
Posts: 1160
Joined: Mon Oct 08, 2007 1:26 am
Location: France, Paris area

Re: Merge/allign cells in Columns macro

Postby marcobernardo » Wed Mar 23, 2016 5:55 pm

B Marcelly wrote:Here is a solution.
Align_cells_AtLeft.ods

Somewhere in columns D to L, it is expected to find 4 data in succession.
Empty lines are skipped.
Adapt to your needs.
Code: Select all   Expand viewCollapse view
Option Explicit

Sub AlignToColumnLeft
Dim sh As Object, zone As Object, dataRow As Variant
Dim y As Long, x1 As Long, x2 As Long
Const minCol = 3, maxCol = 11 ' columns D to L contain data
Const nbrOfValues = 4

sh = ThisComponent.Sheets.getByName("Sheet1")

for y = 0 to 100 ' from row 1 to row 101 (example)
  zone = sh.getCellRangeByPosition(minCol, y, maxCol, y)
  dataRow = zone.DataArray
  dataRow = dataRow(0) ' get the list of data
  x1 = 0
  Do While Len(dataRow(x1)) = 0
    x1 = x1 +1
    if x1 > UBound(dataRow)  then exit do ' no data in this line
  Loop
  if (x1 > 0) and (x1 <= UBound(dataRow))  then
    for x2 = 0 to nbrOfValues -1 ' move data to left
      dataRow(x2) = dataRow(x2 +x1)
    next
    for x2 = nbrOfValues to UBound(dataRow) ' clear the rest
      dataRow(x2) = ""
    next
    zone.dataArray = Array(dataRow)
  end if
next
End Sub



It worked great Bernard!!! :) thank you so much

Now I need to adapt as you said to my needs, the columns should be from B to J in the macro I'm trying to do.

Regards,
Marco
Open Office 4.1.1, OSX 10.11.2
marcobernardo
 
Posts: 8
Joined: Tue Mar 22, 2016 2:30 pm

Re: Merge/allign cells in Columns macro

Postby karolus » Wed Mar 23, 2016 6:14 pm

Hallo

half the lines of code, easier to understand … but python ;-)

Code: Select all   Expand viewCollapse view
def normalize_data():
    
    doc 
= XSCRIPTCONTEXT.getDocument()
    sheet = doc.CurrentController.ActiveSheet
    cursor 
= sheet.createCursor()
    cursor.gotoStartOfUsedArea(0)
    cursor.gotoEndOfUsedArea(1)
    data = cursor.FormulaArray
    size 
= len(data[0])
    out = []

    for row in data:
        row = [entry for entry in row if entry]
        row.extend( [''] * ( size-len(row)) )
        out.append(tuple(row))

    cursor.setFormulaArray( tuple(out))
AOO4, Libreoffice - 5.1 … 5.3.2.2 on Linux Mint17
User avatar
karolus
Volunteer
 
Posts: 852
Joined: Sat Jul 02, 2011 9:47 am

Re: Merge/allign cells in Columns macro

Postby MrProgrammer » Wed Mar 23, 2016 10:58 pm

Hi, and welcome to the forum.

marcobernardo wrote:Here is the final result I like to achieve if possible.
B Marcelly wrote:Adapt to your needs. {30-line macro}
karolus wrote:half the lines of code, easier to understand … but python ;-) {17-line macro}
I've used three short formulas (shown for cell D1 on three new sheets), and no evil macro. If you are not a programmer, it may be easier to understand and adapt a formula solution than a macro solution. You'll need to understand the fundamental spreadsheet concept of relative vs. absolute addressing, explained in the tutorial below.
StepA: =ISTEXT($Data.D1)
StepB: =SUM(C1;MATCH(TRUE();OFFSET($StepA.$A1;0;C1;1;12);0))
Result: =IF(ISNUMBER($StepB.D1);OFFSET($Data.$A1;0;$StepB.D1-1);"")
201603231212.ods
(15.15 KiB) Downloaded 58 times

Read about ISTEXT, SUM, MATCH, TRUE, OFFSET, IF, and ISNUMBER in the Help, in this forum, or in the Wiki. The task is easier if one can assume that the four non-empty cells in a row are adjacent. I supposed they were not.
[Tutorial] Ten concepts that every Calc user should know

If this solved your problem please go to your first post use the Edit button and add [Solved] to the start of the title. You can select the green checkmark icon at the same time.
Mr. Programmer
AOO 4.1.5 Build 9789 on MacOS 10.11.6.   The locale for any menus or Calc formulas in my posts is English (USA).
User avatar
MrProgrammer
Moderator
 
Posts: 3845
Joined: Fri Jun 04, 2010 7:57 pm
Location: Wisconsin, USA

[Solved] Merge/allign cells in Columns macro

Postby marcobernardo » Wed Mar 23, 2016 11:28 pm

MrProgrammer wrote:Hi, and welcome to the forum.

marcobernardo wrote:Here is the final result I like to achieve if possible.
B Marcelly wrote:Adapt to your needs. {30-line macro}
karolus wrote:half the lines of code, easier to understand … but python ;-) {17-line macro}
Three short formulas (shown for cell D1 on three new sheets), no evil macro. If you are not a programmer, it may be easier to understand and adapt a formula solution than a macro solution. You'll need to understand the fundamental spreadsheet concept of relative vs. absolute addressing, explained in the tutorial below.
StepA: =ISTEXT($Data.D1)
StepB: =SUM(C1;MATCH(TRUE();OFFSET($StepA.$A1;0;C1;1;12);0))
Result: =IF(ISNUMBER($StepB.D1);OFFSET($Data.$A1;0;$StepB.D1-1);"")
201603231212.ods

Read about ISTEXT, SUM, MATCH, TRUE, OFFSET, IF, and ISNUMBER in the Help, in this forum, or in the Wiki. The task is easier if one can assume that the four non-empty cells in a row are adjacent. I supposed they were not.
[Tutorial] Ten concepts that every Calc user should know

If this solved your problem please go to your first post use the Edit button and add [Solved] to the start of the title. You can select the green checkmark icon at the same time.


Thank you.

I've just adapted the Bernard code to my needs it worked flawlessly. Thanks again Bernardo

Karolus - I will try that python code too in a few hours. Thank you

This will do what I need and delete some columns that I want. There's another step to clean this sheet, I can't even try to explain If I want I need to think and read. And I can bet that I will need help for sure! :)

My needs is clean a sheet to keep only what I need to see.

Code: Select all   Expand viewCollapse view
REM  *****  BASIC  *****
  Sub Main
AlignToColumnLeft(step1)
S_delete_empty_rows(step2)
  End Sub
 
sub AlignToColumnLeft(step1) rem--- thanks to Bernard Marcelly
dim document   as object
dim dispatcher as object
Dim sh As Object, zone As Object, dataRow As Variant
Dim y As Long, x1 As Long, x2 As Long
Const minCol = 16, maxCol = 24 ' columns D to L contain data
Const nbrOfValues = 4

sh = ThisComponent.Sheets.getByName("Sheet1_2")

for y = 0 to 900 ' from row 1 to row 101 (example)
  zone = sh.getCellRangeByPosition(minCol, y, maxCol, y)
  dataRow = zone.DataArray
  dataRow = dataRow(0) ' get the list of data
  x1 = 0
  Do While Len(dataRow(x1)) = 0
    x1 = x1 +1
    if x1 > UBound(dataRow)  then exit do ' no data in this line
  Loop
  if (x1 > 0) and (x1 <= UBound(dataRow))  then
    for x2 = 0 to nbrOfValues -1 ' move data to left
      dataRow(x2) = dataRow(x2 +x1)
    next
    for x2 = nbrOfValues to UBound(dataRow) ' clear the rest
      dataRow(x2) = ""
    next
    zone.dataArray = Array(dataRow)
  end if
next

document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(0) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "$A$1:$E$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())

rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteColumns", "", 0, Array())
rem ----------------------------------------------------------------------
dim args2(0) as new com.sun.star.beans.PropertyValue
args2(0).Name = "ToPoint"
args2(0).Value = "$B$1:$M$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args2())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteColumns", "", 0, Array())

rem ----------------------------------------------------------------------
dim args3(0) as new com.sun.star.beans.PropertyValue
args3(0).Name = "ToPoint"
args3(0).Value = "$D$1:$Z$1"

dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args3())
rem ----------------------------------------------------------------------
dispatcher.executeDispatch(document, ".uno:DeleteColumns", "", 0, Array())

rem ----------------------------------------------------------------------
end sub

Sub S_delete_empty_rows(step2)  rem--- thanks to F3K Total
    dim bEmpty as boolean
    dim nCounter as integer
    oSheet = thiscomponent.sheets.getbyname("Sheet1_2")
    oCursor = oSheet.createcursor
    oCursor.gotoendofusedarea(false)
    nEndColumn = oCursor.rangeaddress.EndColumn
    nEndrow = oCursor.rangeaddress.Endrow
    nCounter = 0
    for i = nEndrow to 0 step - 1
        bEmpty = true
        for k = 0 to nEndColumn
           ocell = osheet.getcellbyposition(k,i)
           if oCell.Type <> com.sun.star.table.CellContentType.EMPTY then
           bEmpty = false
           exit for
           end if
        next k
        if bEmpty then
            osheet.rows.removeByIndex(i,1)
            nCounter = ncounter + 1
        end if
    next i
    msgbox (nCounter & " rows deleted",64,"Success")
end sub
Open Office 4.1.1, OSX 10.11.2
marcobernardo
 
Posts: 8
Joined: Tue Mar 22, 2016 2:30 pm

Re: [Solved] Merge/allign cells in Columns macro

Postby marcobernardo » Sun Mar 27, 2016 11:52 pm

Here is a https://youtu.be/5FApxj7by2o what I could achieve with your help.

Thank you all
Regards,
Marco
Open Office 4.1.1, OSX 10.11.2
marcobernardo
 
Posts: 8
Joined: Tue Mar 22, 2016 2:30 pm


Return to Macros and UNO API

Who is online

Users browsing this forum: No registered users and 7 guests