#1
|
|||
|
|||
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 |
#2
|
||||
|
||||
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 |
#3
|
|||
|
|||
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. |
#4
|
||||
|
||||
Run the macro blah (which calls the macro CleanUp) on the workbook you attached.
Assumptions:
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 |
Tags |
blocks, order |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
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 |
Mail merge conditional adress blocks. | Thrizian | Mail Merge | 2 | 07-17-2012 10:41 PM |
how to use Building Blocks or controls to add a page | verbster | Word | 11 | 03-06-2011 04:05 PM |
moving data from single to multiple columns? | mzimmers | Excel | 3 | 08-23-2010 08:20 AM |