![]() |
pair single column to multiple column
Does anybody know how to (NOT manually) convert in:
0030 0039 日联飞翼证券亚洲有限公司 0040 0049 富业证券投资有限公司 0050 0059 通陆证券有限公司 0060 0069 鼎成证券有限公司 0080 0089 丰年证券投资有限公司 0090 0099 泰山证券有限公司 to: 0030 0039 日联飞翼证券亚洲有限公司 0050 0059 通陆证券有限公司 0080 0089 丰年证券投资有限公司 0040 0049 富业证券投资有限公司 0060 0069 鼎成证券有限公司 0090 0099 泰山证券有限公司 certainly some criteria are to be used as division points (e.g. 3 columns, starting from some value 0080, ...) Thx in advance!!! |
Sub Test()
Const kStep As Long = 4 Dim rng As Range Dim iLastRow As Long Dim i As Long, j As Long iLastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To iLastRow Step kStep For j = 1 To kStep - 1 Cells(i, (j * 3) + 1).Value = Cells(i + j, "A").Value Cells(i, (j * 3) + 2).Value = Cells(i + j, "B").Value Cells(i, (j * 3) + 3).Value = Cells(i + j, "C").Value If rng Is Nothing Then Set rng = Cells(i + j, "A").EntireRow Else Set rng = Union(rng, Cells(i + j, "A").EntireRow) End If Next j Next i rng.Delete End Sub -- HTH Bob Phillips "Ross" wrote in message ... Does anybody know how to (NOT manually) convert in: 0030 0039 日联飞翼证券亚洲有限公司 0040 0049 富业证券投资有限公司 0050 0059 通陆证券有限公司 0060 0069 鼎成证券有限公司 0080 0089 丰年证券投资有限公司 0090 0099 泰山证券有限公司 to: 0030 0039 日联飞翼证券亚洲有限公司 0050 0059 通陆证券有限公司 0080 0089 丰年证券投资有限公司 0040 0049 富业证券投资有限公司 0060 0069 鼎成证券有限公司 0090 0099 泰山证券有限公司 certainly some criteria are to be used as division points (e.g. 3 columns, starting from some value 0080, ...) Thx in advance!!! |
Sorry, kStep should be a value of 3, I tested with 4 and didn't revert it.
-- HTH Bob Phillips "Ross" wrote in message ... Does anybody know how to (NOT manually) convert in: 0030 0039 日联飞翼证券亚洲有限公司 0040 0049 富业证券投资有限公司 0050 0059 通陆证券有限公司 0060 0069 鼎成证券有限公司 0080 0089 丰年证券投资有限公司 0090 0099 泰山证券有限公司 to: 0030 0039 日联飞翼证券亚洲有限公司 0050 0059 通陆证券有限公司 0080 0089 丰年证券投资有限公司 0040 0049 富业证券投资有限公司 0060 0069 鼎成证券有限公司 0090 0099 泰山证券有限公司 certainly some criteria are to be used as division points (e.g. 3 columns, starting from some value 0080, ...) Thx in advance!!! |
"Bob Phillips" wrote in message ... Sub Test() Const kStep As Long = 4 Dim rng As Range Dim iLastRow As Long Dim i As Long, j As Long iLastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To iLastRow Step kStep For j = 1 To kStep - 1 Cells(i, (j * 3) + 1).Value = Cells(i + j, "A").Value Cells(i, (j * 3) + 2).Value = Cells(i + j, "B").Value Cells(i, (j * 3) + 3).Value = Cells(i + j, "C").Value If rng Is Nothing Then Set rng = Cells(i + j, "A").EntireRow Else Set rng = Union(rng, Cells(i + j, "A").EntireRow) End If Next j Next i rng.Delete End Sub -- HTH Bob Phillips Dear Bob Phillips, where to run the above codes? thx again :) --Ross |
I am interested in something similar to this. I would like to do make this: 1 2 3 4 5 6 7 8 9 10 11 12 into this: 1 5 9 2 6 10 3 7 11 4 8 12 However, I need something that is flexible. For example, sometimes I will need to make 3 columns of 4 rows and sometimes I will need 2 of 6. Sometimes I will have many more columns and rows. In other words, the data will take on different shapes and sizes. Therefore, something specific to the cells (ie in a macro) is only useful once. Therefore, anyone know of a function that I can use to manipulate data in this way? -- daufoi ------------------------------------------------------------------------ daufoi's Profile: http://www.excelforum.com/member.php...o&userid=23911 View this thread: http://www.excelforum.com/showthread...hreadid=374965 |
sub RuntThis() Call myArrange(4, 3) End Sub Sub myArrange(rows, columns) Set rng = Range("A1:A12") For i = 1 To rng.Count If i Mod rows = 0 Then r = rows If i Mod rows < 0 Then r = i Mod rows If i Mod rows = 0 Then c = Int(i / rows) If i Mod rows < 0 Then c = Int(i / rows) + 1 temp = rng(i, 1) rng(i, 1).Clear rng(r, c) = temp Next i End Sub Mangesh -- mangesh_yadav ------------------------------------------------------------------------ mangesh_yadav's Profile: http://www.excelforum.com/member.php...o&userid=10470 View this thread: http://www.excelforum.com/showthread...hreadid=374965 |
Go to the VB IDE (Alt-F11), insert a new module (menu InsertModule), copy
the code in there, and then in Excel goto menu ToolsMacroMacros... and select and run Test. -- HTH Bob Phillips "Ross" wrote in message ... "Bob Phillips" wrote in message ... Sub Test() Const kStep As Long = 4 Dim rng As Range Dim iLastRow As Long Dim i As Long, j As Long iLastRow = Cells(Rows.Count, "A").End(xlUp).Row For i = 1 To iLastRow Step kStep For j = 1 To kStep - 1 Cells(i, (j * 3) + 1).Value = Cells(i + j, "A").Value Cells(i, (j * 3) + 2).Value = Cells(i + j, "B").Value Cells(i, (j * 3) + 3).Value = Cells(i + j, "C").Value If rng Is Nothing Then Set rng = Cells(i + j, "A").EntireRow Else Set rng = Union(rng, Cells(i + j, "A").EntireRow) End If Next j Next i rng.Delete End Sub -- HTH Bob Phillips Dear Bob Phillips, where to run the above codes? thx again :) --Ross |
All times are GMT +1. The time now is 10:53 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com