VBAでのデータ転記（再）

質問

データがsheet1に縦記述で書いてあります。
C列　D列
ああ　A01
いい　A02
うう　A03
.
ささ　B01
しし　B02
すす　B03
.
はは　AA01
ひひ　AA02
ふふ　AA03
.
やや　AB01
ゆゆ　AB02
よよ　AB03
.
D列を元にしてC列の文字列をsheet2に以下のように並べたいです。D列はアドレス扱いででアルファベットが変わったら改行してデータを並べるようにします。
A列　　B列　C列
ああ　いい　うう・
ささ　しし　すす・
・・・・・
はは　ひひ　ふふ・
やや　ゆゆ　よよ・

作成したコード

Dim I As Integer, MAE As String, IMA As String, TEMP2 As String
Dim X1 As Integer, Y1 As Integer, X3 As Integer, Y3 As Integer, PINNAME As String
X1 = 4: Y1 = 2
X3 = 1: Y3 = 1

MAE = Sheets("Sheet1").Cells(Y1, X1)
Do
PINNAME = Sheets("Sheet1").Cells(Y1, X1 - 1)
IMA = Sheets("Sheet1").Cells(Y1, X1) '今の値が入っている
If IMA = "" Then
Exit Do
End If

If Left(MAE, 1) <> Left(IMA, 1) Then
Y3 = Y3 + 1: X3 = 1
Sheets("Sheet2").Cells(Y3, X3).Value = PINNAME
X3 = X3 + 1
Else
Sheets("Sheet2").Cells(Y3, X3).Value = PINNAME
X3 = X3 + 1
End If
MAE = Sheets("Sheet1").Cells(Y1, X1)
Y1 = Y1 + 1
Loop Until IMA = ""

Left関数でアドレスの左1文字を前後のセルで比較して異なる場合、改行する方法を考えましたが、AA01　AA02・・・がムリです。このコードに補足すればできるでしょうか？それとも別の考え方で行った方がいいでしょうか？
初心者レベルなので考え方も教えて下さい。宜しくお願いします。

回答No.5

imogasi

参考になれば。暇なときに比べてみてください。
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
i = 2　'1スタート行
k = 1 'Sheet2の行
d = sh1.Range("A65536").End(xlUp).Row
p01:
If i > d Then GoTo end1
For j = 1 To 3
sh2.Cells(k, j) = sh1.Cells(i, "A")
i = i + 1
Next j
i = i + 1 '1行空白あるものとする
k = k + 1 '次行へ
GoTo p01
'----
end1:
End Sub
データ
A2:A12に
a
b
c

c
d
f

g
h
j
がShhet2のA1:C3に
a b c
c d f
g h j
になる。

お礼

ありがとうございます。
今度やってみます。

回答No.4

g_nekoru

質問中には特に書いてませんでしたが、見る限りsheet1のデータの開始行は２行目ですよね？

質問に書いてある物とは違ってしまいますが、問題を勘違いしていなければ以下のような記述で行けると思います。

それと#1の方が言っているように再質問する場合は前の質問は締めたほうがいいかもしれませんね^^;

Sub test()
Dim SHT1_Y As Integer, SHT1_X As Integer, SHT2_Y As Integer, SHT2_X As Integer
Dim PRE_ROW As String, NOW_ROW As String, MAX_ROW As Integer
Dim L As Integer

SHT1_X = 3
SHT2_Y = 0
PRE_ROW = ""
MAX_ROW = Cells(65536, SHT1_X).End(xlUp).Row '65536はお使いのExcelの最大行数

For SHT1_Y = 2 To MAX_ROW
If Cells(SHT1_Y, SHT1_X) <> "" Then
L = 2
While Mid(Cells(SHT1_Y, SHT1_X + 1), L, 1) Like "[A-Z]"
L = L + 1
Wend
NOW_ROW = Mid(Cells(SHT1_Y, SHT1_X + 1), L - 1, 1)
SHT2_X = Int(Mid(Cells(SHT1_Y, SHT1_X + 1), L, Len(Cells(SHT1_Y, SHT1_X + 1)) - L + 1))
If NOW_ROW <> PRE_ROW Then
SHT2_Y = SHT2_Y + 1
PRE_ROW = NOW_ROW
End If
Sheets("Sheet2").Cells(SHT2_Y, SHT2_X) = Cells(SHT1_Y, SHT1_X)
End If
Next
End Sub

お礼

ありがとうございました。
行列対応の仕組みが何とか理解できました。

回答No.3

BLUEPIXY

>Left関数でアドレスの左1文字を前後のセルで比較して
数字の部分が２桁で決まっていて、英字の部分が不定長なのであれば、
LEFT(文字列,LEN(文字列)-2)の部分で、比較すればいいんじゃないですか

お礼

今のプログラムに簡単に付け足せてよいですね。
ありがとうございました。

回答No.2

g_nekoru

実際にD列のアルファベットと数値に行列を合わせる必要はありますか？
例えば
A01 の次がA03だったとしたら
Ａ列　Ｂ列　Ｃ列
ああ　　　　うう
のようにB列を抜かしたり

A01 の次がC01
Ａ列
ああ

ささ
のように１行飛ばしたりするのでしょうか？

それと、単に中間を略しているだけかもしれませんが、
うう　A03
.
ささ　B01
のように１行飛びの部分もあるのでしょうか？
あるとしたらそこは空白になりますか？
それとも質問文のように"."が入りますか？

補足

(1)　D列のアルファベットと数値に行列を合わせる必要はあります。（合わせられない場合は後に手動で動かすことを考えていました）
(2)　1行飛ばしはありません。
(3)　A03　B01のような列飛ばしは(1)の関係からあります。その部分は空白になります。

以上、宜しくお願いします。

回答No.1

Wendy02

aki4720　さま

質問はともかく、この投稿の時点では、以下の問題のこちらのコメントもつけず、そのままにして、同様の質問を出すのは、マナーとしていかがなものかなって思います。ロジックとしては変わらないのですから、以下の私のコードを読み解けば、可能です。

http://oshiete1.goo.ne.jp/kotaeru.php3?q=1613040

比較する対象列
With Range("A1", Range("A1").End(xlDown))
　　↓
D列にする。

Range(.Cells(r1, myCol), .Cells(r2, myCol)).Copy
　　↓
C列だから、Offset(,-1)
で済むと思います。

もし、マクロの勉強の一つなら、あまり掲示板に安易に聞く方法よりも、自分で、Visual Basic Editor のデバッギングツールを使いながら、完成させたほうがよいです。
デバッギング・ツールを十分に使いこなせるようになると、自分の技術も向上していきます。

ただ、概ね、うまく出来ない時は、自分の技術が未熟なのであって、手がけたものはあっさり捨てたほうがよいです。他人のコードを参考にしながら、そのコードを借用していき、それで上達します。今回のものは、マクロ初心者というレベルで出来るかどうかは、私には分りません。

お礼

どうもありがとうございました。
初めての利用でしたのでよくわからず、マナーの件については失礼しました。自分がかなり未熟なこともわかり、解読中でまだ時間がかかりそうなのでお礼を先に伝えます。