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" <a@cuhk.edu.hk> wrote in message
news:d7dl4v$1ahc$1@justice.itsc.cuhk.edu.hk...
> 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" <a@cuhk.edu.hk> wrote in message
news:d7dl4v$1ahc$1@justice.itsc.cuhk.edu.hk...
> 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" <phillips@tiscali.co.uk> wrote in message
news:uWJ4x8PZFHA.1044@TK2MSFTNGP10.phx.gbl...
> 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

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.

--
HTH

Bob Phillips

"Ross" <a@cuhk.edu.hk> wrote in message
news:d7jbam$2j67$1@justice.itsc.cuhk.edu.hk...
>
> "Bob Phillips" <phillips@tiscali.co.uk> wrote in message
> news:uWJ4x8PZFHA.1044@TK2MSFTNGP10.phx.gbl...
> > 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
>
>