Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 02-13-2018, 09:13 AM
GEORGEJUNGCOCAINE GEORGEJUNGCOCAINE is offline merge blocks of columns into a single page Windows Vista merge blocks of columns into a single page Office 2007
Novice
merge blocks of columns into a single page
 
Join Date: Aug 2013
Posts: 6
GEORGEJUNGCOCAINE is on a distinguished road
Default merge blocks of columns into a single page

Hi community,



Fist of all, sorry for my lack of proper terminology.

Working on Excel 2016, the sheet is 61 pages, each containing 41 rows and 12 columns from A to L (that is, 3 blocks of 4 columns each).

First, I need to orderly create a single block of 4 columns in every page.

Secondly, I want to merge all the 61 pages, now consisting each of a single block of 4 columns and 123 rows (41 rows x 3 blocks), into a single one containing 4 columns and 7506 rows (123 rows each page x 61 pages of the sheet).

This is what a typical row looks like, taking | as a separator for columns 正|改正|V|B|值|值得正|A|F|挚|真挚 A|B and they should become

正|改正 |V|B|

值|值得正|A|F|

挚|真挚 A|B|

I do not know whether Excel options enable getting the final result of a macro would make it easier.

Hope to hear news soon.
Thanks in advance.

Last edited by GEORGEJUNGCOCAINE; 02-14-2018 at 06:33 AM. Reason: typo
Reply With Quote
  #2  
Old 02-14-2018, 01:02 PM
p45cal's Avatar
p45cal p45cal is offline merge blocks of columns into a single page Windows 10 merge blocks of columns into a single page Office 2010 32bit
Expert
 
Join Date: Apr 2014
Posts: 863
p45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant future
Default

As a start, try running this code on your sheet. It doesn't change that sheet, it creates a new sheet and puts data there. It's a bit slow.
Is this doing the right thing?
Code:
Sub blah()
  Set mySht = ActiveSheet
  Set NewSht = Sheets.Add(after:=Sheets(Sheets.Count))
  Set Destn = NewSht.Range("A1")
  For Each rw In mySht.Range("A1").CurrentRegion.Rows
    For i = 0 To 8 Step 4
      rw.Offset(, i).Resize(, 4).Copy Destn
      Set Destn = Destn.Offset(1)
    Next i
  Next rw
End Sub
It would be better if you were to supply a sheet/workbook with data in.
Reply With Quote
  #3  
Old 02-16-2018, 07:54 PM
GEORGEJUNGCOCAINE GEORGEJUNGCOCAINE is offline merge blocks of columns into a single page Windows Vista merge blocks of columns into a single page Office 2007
Novice
merge blocks of columns into a single page
 
Join Date: Aug 2013
Posts: 6
GEORGEJUNGCOCAINE is on a distinguished road
Default

Quote:
Originally Posted by p45cal View Post
As a start
Yet, there's one more operation I need to carry out that I forgot to mention.

I need to divide into two those cells containing a string of Chinese characters follow by a string of Latin ones, which are separated by a space, so that each string of different scripts belong to a different column. These cells always appear in the second colum of a block of four columns.

Supposing one block of four columns, and four rows as a mere example
Captura.JPG

Finally, a new sheet/page of four columns, A-D, would contain all the fixed rows.

Here's the whole document I need to process elastic list.perpage50.xlsx

Please, notice the the last row of each page (number 42, except for the las page 61, which is number 6) just contains merged cells with the number of page, so these rows should not be taken into account, and if possible deleted.

I am afraid I am a newbie, so I trust your recommendations. I hope the whole process can be fully automated.

If any further clarification is necessary, please let me know.
Reply With Quote
  #4  
Old 02-17-2018, 08:36 AM
p45cal's Avatar
p45cal p45cal is offline merge blocks of columns into a single page Windows 10 merge blocks of columns into a single page Office 2010 32bit
Expert
 
Join Date: Apr 2014
Posts: 863
p45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant futurep45cal has a brilliant future
Default

Run the macro blah (which calls the macro CleanUp) on the workbook you attached.

Assumptions:
  • More than 2 cells merged on one row results in that row being deleted.
  • Exactly 2 merged cells need splitting using Text to columns with a space as delimiter (I have ignored whether they're latin or chinese characters).
  • ALL existing sheets in the workbook need processing.

A new sheet called Results is created (so there mustn't already be a sheet with that name).
All sheets are altered (merged cells unmerged, a row probably deteted at the bottom, and some cells processed with Text to Columns).

Near the bottom of the Results sheet there is a blank row; this is because the sheet Page 61 has blanks in the cells I4:L4.

It takes about 30 seconds to run here.

The code:
Code:
Sub blah()
Application.ScreenUpdating = False
With Application.FindFormat
  .Clear
  .MergeCells = True
End With
Set wbk = ActiveWorkbook
Set NewSht = Sheets.Add(after:=wbk.Sheets(wbk.Sheets.Count))
NewSht.Name = "Results"
Set Destn = NewSht.Range("A1")
For Each sht In wbk.Sheets
  If sht.Name <> "Results" Then
    CleanUp sht
    For Each rw In sht.Range("A1").CurrentRegion.Rows
      For i = 0 To 8 Step 4
        rw.Offset(, i).Resize(, 4).Copy Destn
        Set Destn = Destn.Offset(1)
      Next i
    Next rw
  End If
Next sht
With NewSht
  .Cells.WrapText = False
  .UsedRange.Columns.EntireColumn.AutoFit
  .UsedRange.Rows.EntireRow.AutoFit
End With
Application.ScreenUpdating = True
Application.FindFormat.Clear
End Sub

Sub CleanUp(theSheet)
myFieldInfo = Array(Array(1, 1), Array(2, 1), Array(3, 9), Array(4, 9), Array(5, 9), Array(6, 9), Array(7, 9), Array(8, 9), Array(9, 9), Array(10, 9))
Set xxx = theSheet.UsedRange.Find("*", LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=True)
Do Until xxx Is Nothing
  Set ddd = xxx.MergeArea
  If ddd.Rows.Count = 1 And ddd.Cells.Count > 2 Then
    ddd.EntireRow.Delete
  Else
    ddd.MergeCells = False
    Application.DisplayAlerts = False
    ddd.Cells(1).TextToColumns DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Space:=True, FieldInfo:=myFieldInfo
    Application.DisplayAlerts = True
  End If
  Set xxx = theSheet.UsedRange.Find("*", LookIn:=xlFormulas, lookat:=xlWhole, searchformat:=True)
Loop
End Sub
Reply With Quote
Reply

Tags
blocks, order

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
merge blocks of columns into a single page Writing in columns and text blocks Vazrael Word 9 08-19-2016 12:20 AM
Merge csv data onto one A4 page containing columns gerrymac Word 1 04-17-2016 02:32 PM
merge blocks of columns into a single page Mail merge conditional adress blocks. Thrizian Mail Merge 2 07-17-2012 10:41 PM
merge blocks of columns into a single page how to use Building Blocks or controls to add a page verbster Word 11 03-06-2011 04:05 PM
merge blocks of columns into a single page moving data from single to multiple columns? mzimmers Excel 3 08-23-2010 08:20 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 01:56 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft