pair single column to multiple column

[Ross]

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]

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

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 ̩ɽ֤ȯÓÐÏÞ¹«Ë¾

 

[Bob Phillips]

Sorry, kStep should be a value of 3, I tested with 4 and didn't revert it.

--
HTH

Bob Phillips

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 ̩ɽ֤ȯÓÐÏÞ¹«Ë¾

 

[Ross]

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

Dear Bob Phillips,
where to run the above codes? thx again

--Ross

 

[daufoi]

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?

 

[mangesh_yadav]

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

 

[Bob Phillips]

Go to the VB IDE (Alt-F11), insert a new module (menu Insert>Module), copy
the code in there, and then in Excel goto menu Tools>Macro>Macros... and
select and run Test.