VBAでのデータ転記

質問

データがsheet1に縦記述で書いてあります。
A01
A02
A03
.
.
B01
B02
B03
.
.
AA01
AA02
AA03
.
.
AB01
AB02
AB03
.
.
これをsheet2に以下のように並べ替えたいのです。
A01 A02 A03・・・
B01 B02 B03・・・
・・・・・
AA01 AA02 AA03・・・
AB01 AB02 AB03・・・

Left関数で文字列の左1文字を前後のセルで比較して異なる場合、改行する方法を考えましたが、AA01　AA02・・・になると左から２番目の文字で判断しなければなりません。なにかいい方法はあるでしょうか？
ご指導宜しくお願いいたします。

回答No.2

Wendy02

こんばんは。

コードを見せていただいたほうがいいと思いますが、このマクロは、いつも書いている人でないと、なかなかできないような気がしますね。今回、いつも使わないオーソドックスなパターンを使っています。

以下は、データがすでに、並び替えが済んでいるものとします。
アクティブシートから、設定したシートに吐き出します。

'<標準モジュールの登録>
Option Explicit
Sub testSample()
　Dim Rng As Range
　Dim CopySh As Worksheet
　Dim rw As Long
　Dim i As Long, j As Long, r As String
　Dim r1 As Long, r2 As Long
　Dim shCount As Integer
　Dim myCol As Integer
　'ユーザー設定
　'=======================================
　Set CopySh = Worksheets("Sheet2")
　rw = 1　'コピー先の最初の書き出し行
　'=======================================
　Application.ScreenUpdating = False
　With Range("A1", Range("A1").End(xlDown))
　　i = 1: j = 1
　　Do
　　　Do
　　　　r = SearchMoji(.Cells(j, 1).Value)
　　　　j = j + 1
　　　Loop While r = SearchMoji(.Cells(j, 1).Value)
　　　r1 = i
　　　r2 = j - 1
　　　'コピー処理
　　　Range(.Cells(r1, myCol), .Cells(r2, myCol)).Copy
　　　CopySh.Cells(rw, 1).PasteSpecial , Transpose:=True
　　　rw = rw + 1
　　　i = j
　　　j = j
　　Loop Until i > .Rows.Count
　End With
　Application.CutCopyMode = True
　Application.ScreenUpdating = True
　Set CopySh = Nothing
　MsgBox "終了!"
End Sub
Private Function SearchMoji(arg1 As String)
Dim myStr As String, i As Integer
myStr = Application.Substitute(arg1, Space(1), "")
For i = Len(myStr) To 1 Step -1
　 If IsNumeric(Mid(myStr, i, 1)) = False Then
　　 Exit For
　 End If
Next i
If i = 0 Then
　SearchMoji = myStr
Else
　SearchMoji = Mid$(myStr, 1, i)
End If
End Function

回答No.1

pascal3141

後ろの説明に書いてあるようにできるのでしたら、A01～Z99までの先頭に文字の合成でなにかわかりやすい１文字（たとえば＠など）を付け加えて文字数を2文字に直して、left関数で2文字を切り出して比較してはどうでしょうか？