エクセルのマクロについて教えて下さい。

質問

エクセルのマクロについて教えて下さい。

Sub Ref()

Dim ax As String
Dim num As Integer, i As Integer
Dim arr As Variant
Dim tex As String

Range("A1").Select
ax = ActiveCell.Formula

arr = Split(ax, ",")

For i = 0 To UBound(arr)
num = i + 1
Cells(num, 1).Value = arr(i)
Next i

For i = 1 To 10

ActiveCell.Offset(, 1).Select
tex = ActiveCell.Formula

Selection.Resize(num, 1).Select
Selection.Formula = tex
Selection.Resize(1, 1).Select

Next i

End Sub

このマクロを10行ほどまで対応させたいです。
例として2行の表ですが、
　　　 　 　　　 A 　　　　　　　 B 　 C 　D 　 E 　F
１　C100,C101,C102,C103 aaa bbb ccc ddd eee
２　C104,C105,C106,C107
とうい表を、
　　　 A B 　C 　D 　 E 　 F
１　C100 aaa bbb ccc ddd eee
２　C101 aaa bbb ccc ddd eee
３　C102 aaa bbb ccc ddd eee
４　C103 aaa bbb ccc ddd eee
５　C104 aaa bbb ccc ddd eee
６　C105 aaa bbb ccc ddd eee
７　C106 aaa bbb ccc ddd eee
８　C107 aaa bbb ccc ddd eee

という表にしたいです。
結合してから展開しようと考えたのですが
１列目の文字列の最後にカンマが無い場合、ある場合がありまして、
対応する事が出来ませんでした。
マクロ初心者なので教えてください。
よろしくお願いします。

回答No.2

tom04 · ベストアンサー

こんばんは！
横からお邪魔します！

http://okwave.jp/qa/q6975093.html
で投稿した者です。
↑のコードは↓の画像の左側の表のような感じでも対応できるコードにしていました。
（余計なお世話をやき過ぎていた感があります）

今回はB列以降が空白の場合があるというコトなので、
画像の右側の表でも対応できるように前回のコードに少し手を加えてみました。

Sub test3()
Dim i, j, k, L, M As Long
Dim myArray As Variant
L = Cells(1, Columns.Count).End(xlToLeft).Column
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
myArray = Split(Cells(i, 1), ",")
k = UBound(myArray)
If k > 0 Then
Rows(i + 1 & ":" & i + k).Insert
End If
For j = 0 To k
For M = 2 To L
Cells(i + j, 1) = myArray(j)
Cells(i + j, M) = Cells(i, M)
Next M
Next j
Next i
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To L
If Cells(i, j) = "" Then
Cells(i, j) = Cells(i - 1, j)
End If
Next j
Next i
For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
If Cells(i, 1) = "" Then
Rows(i).Delete
End If
Next i
Range(Columns(1), Columns(L)).AutoFit
Range(Columns(1), Columns(M)).AutoFit
End Sub

※　今回も列数は1行目の項目が入力されているすべての列まで対応できるようにしています。
※　For～Nextを多用していますので若干時間がかかるかもしれません。

以上、参考になれば良いのですが・・・m(_ _)m

回答No.5

FINE9

No.1です。回答ではなく質問ですみませんが・・・

(1)元データに空白行（空白セル）がありますが、この空白は
　 取り除いてはいけないのでしょうか？

(2)元データの列数・行数は決まっているのでしょうか？

(3)最終的にどういう形になさりたいのでしょうか。
　 実例をプリントスクリーンして貼付していただけると、わかりやすいのですが。

上記を記入の上、別項にて再度ご質問いただけますか？
私は初心者なのでできるかどうかわかりませんが、わかる範囲内で考えて
みたいと思います。

回答No.4

FINE9

No.1です。

A列に入っているデータの個数は複数あり、その末尾にカンマがついていたりいなかったりする。

上記を前提として修正したものを以下に挙げます。
(Do Loopステートメントは使いませんでした）

Sub test2()

Dim ax As String 'A列のセルに入っているテキストを代入するための変数
Dim ax2 As String 'axを統合したテキストを代入するための変数
Dim num As Integer, i As Integer '回数を代入するための変数
Dim arr As Variant '配列を格納
Dim tex As String 'B列以降の文字列を代入するための変数

'A列にいくつデータが入っているかを確かめ、その数をnumに代入

Range("A1").Select
Selection.CurrentRegion.Select
num = Selection.Rows.Count
Range("A1").Select

'A1のテキストの最後にカンマが入っているかを判定。なければカンマをつける。
'A列のデータが入っている最後のセルまで上記の処理を行う。
'各テキストは変数axに代入、ax2で統合する

For i = 1 To num
ax = ActiveCell.Text

If Right(ax, 1) = "," Then

ax = ax

Else
ax = ax & ","

End If

If i = 1 Then

ax2 = ax
Else
ax2 = ax2 & ax

End If

ActiveCell.Offset(1).Select

Next i

ax2 = Left(ax2, Len(ax2) - 1)　

arr = Split(ax2, ",")

Range("A1").Select

For i = 0 To UBound(arr)
num = i + 1
Cells(num, 1).Value = arr(i)
Next i

Range("A1").Select
Selection.CurrentRegion.Select
num = Selection.Rows.Count

'B～D列を展開

For i = 1 To 3

ActiveCell.Offset(, 1).Select
tex = ActiveCell.Formula

Selection.Resize(num, 1).Select
Selection.Formula = tex
Selection.Resize(1, 1).Select

Next i

End Sub

お礼

なるほど・・・。
本当に申し訳ないのですがもう一つ質問です（＞＜）
今のマクロですとB列以降の文字列がコピーされていきます。
もし、B列１行目以降とB列２行目以降が違っている時はどうすればいいですか？？
１　C102,C103,C104 aaa bbb ccc ddd～
２　R102,R103,R105 YYY RRR EEE GGG～
３　R106,R107,R108 　 空白(上と同じ)
４ 空白
５　L102,L103,L105 QQQ MMM NNN BBB～

という場合です。難しすぎてわけがわかりません。
どうかお願いしますm（__）m

回答No.3

tom04

No.2です！

たびたびごめんなさい。
前回のコード内で不要な行がありました。
最後から2行目の
＞Range(Columns(1), Columns(M)).AutoFit

は全く無意味でした。
削除してください。
何度も失礼しました。m(_ _)m

回答No.1

FINE9

昨日の者です。
A1、A2にテキストがあるという前提です。

Sub test2()

Dim ax As String 'A1セルに入っているテキストを代入するための変数
Dim num As Integer, i As Integer '個数や回数を代入するための変数
Dim arr As Variant '配列を格納
Dim tex As String '文字列を代入するための変数

'A1セルの最後にカンマが入っているかを判定し、
A列にテキストを展開していく

Range("A1").Select
ax = ActiveCell.Formula　'A1セルのテキストを変数axに代入

If Right(ax, 1) = "," Then

Range("A2").Select
ax = ax & ActiveCell.Formula 　'変数axにA2セルのテキストを結合
Else
Range("A2").Select
ax = ax & "," & ActiveCell.Formula '変数axのうしろにカンマを入れてA2セルのテキストを結合

End If

arr = Split(ax, ",")

Range("A1").Select

For i = 0 To UBound(arr)
num = i + 1
Cells(num, 1).Value = arr(i)
Next i

'B～D列を展開

For i = 1 To 3

ActiveCell.Offset(, 1).Select
tex = ActiveCell.Formula

Selection.Resize(num, 1).Select
Selection.Formula = tex
Selection.Resize(1, 1).Select

Next i

End Sub

お礼

いつもありがとうございます。
これをA2、A3、A4と繰り返す指示をするのは
Do～LooPでやるんでしょうか？