こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルのマクロについて質問です。

下の表を展開したいです。
   A   B   C  D  E  F  G
1 C102,C103,C104 aaa bbb ccc ddd~
2 R102,R103,R105 YYY RRR EEE GGG~
3 R106,R107,R108   空白(上と同じ)
4 空白
5 L102,L103,L105 QQQ MMM NNN BBB~
という表を、
1 C102 aaa bbb ccc ddd
2 C103 aaa bbb ccc ddd
3 C104 aaa bbb ccc ddd
4 R102 YYY RRR EEE GGG
というように最後まで展開していきたいです。
下のマクロだとB列以降が全て一番上と同じ文字列がコピーされてしまいます。
よろしくお願いします。

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

投稿日時 - 2011-09-02 10:21:05

QNo.6983819

困ってます

質問者が選んだベストアンサー

横からお邪魔します。
同じ質問が数日前から出ていますが・・・

http://okwave.jp/qa/q6979590.html

で回答したものです。
補足も返答もなかったので解決したのかと思っていました。

上記URLのコードは画像を添付しているようにデータが2行目からのコードで、1行目で列数を判断しています。

実際のデータが1行目からということであれば前回のコードの1行だけを変更すれば大丈夫だと思います。

>For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1

>For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
のようにすればご希望に近い形になると思います。

余計なお世話かもしれませんが、もう一度コードを載せておきます。

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 1 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
End Sub

これでNo.2さんと同じような動きになると思います。m(__)m

投稿日時 - 2011-09-02 15:58:58

お礼

ごめんなさい><
やっと解決しました。
何度も申し訳ありませんでした。。

投稿日時 - 2011-09-02 16:32:33

ANo.3

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.2

ANo.1です。

補足読みました。
まず、行の追加・削除をする場合は、シートの上から下へ見て行くのではなく、下から上に見て行った方がよいです。
そうしないと、追加・削除をした事で対象の行位置が変わってしまい、大変判りにくくなるからです。

一応、サンプルを載せます。
元のソースを活かしたかったのですが、全然別物になってしまいました。

Sub Sample()
  Dim nLast As Long
  Dim vAdata, i, j
  Dim vData
  
  nLast = Cells(Rows.Count, 1).End(xlUp).Row
  
  '行を追加削除する時は下から上が基本
  For i = nLast To 1 Step -1
    vAdata = Cells(i, 1)
    'A列が空白ではなく、B列が空白の場合、B列以降を上と同じにする
    If (vAdata <> "") And (Cells(i, 2) = "") And (i > 1) Then
      Rows(i) = Rows(Cells(i, 2).End(xlUp).Row).Value
      Cells(i, 1) = vAdata
    End If
    
    If vAdata = "" Then
      'A列の値が空白なら削除
      Rows(i).Delete Shift:=xlUp
    Else
      'A列の最後に「,」が有る場合は取り除く
      If Right(vAdata, 1) = "," Then
        vAdata = Left(vAdata, Len(vAdata) - 1)
      End If
      
      vData = Split(vAdata, ",")
      'A列の値がカンマで区切られていた場合
      If UBound(vData) > 0 Then
        '対象行をコピーして区切られていた数-1だけ下に挿入
        Rows(i).Copy
        Rows(i & ":" & i + UBound(vData) - 1).Insert Shift:=xlDown
        'A列の値を区切られていた値に書き換える
        For j = 0 To UBound(vData)
          Cells(i + j, 1) = vData(j)
        Next j
      End If
    End If
  Next i
End Sub

投稿日時 - 2011-09-02 15:03:41

お礼

ありがとうございました!!!!!
助かりました(^^)

投稿日時 - 2011-09-02 16:30:50

ANo.1

補足願います。
1.A1に入っているのは「C102」?「C102,C103,C104」?
2.「aaa」「bbb」等はどこのセル?
3.3行目の「空白(上と同じ)」の意味は?
4.空行がある時どうするの?

投稿日時 - 2011-09-02 13:00:05

補足

修正です。
      A列          B列    C列     D列      E列
1行 C101,C102,C103     aaa    bbb    ccc    ddd
2行 R101,R102,R103,    eee    fff    ggg    hhh
3行 R104,R105,R106           
4行目は空行
5行 L101,L102,L103      nnn   lll    ooo     ppp
 
という表です。

投稿日時 - 2011-09-02 14:24:50

お礼

ごめんなさい。まったくわかりませんよね。。
補足させて頂きます。
      A列        B列    C列    D列       E列
1行 C101,C102,C103 aaa    bbb    ccc      ddd
2行 R101,R102,R103, eee    fff     ggg       hhh
3行 R104,R105,R106          
4行目は空行
5行 L101,L102,L103nnnllloooppp
 
という表です。B列以降の列には商品名やメーカーや価格などが入ります。
2行目と3行目は同じ商品なのでB列以降が省略されてしまっています。
4行目の空行は詰めたいです。
結果、
      A列        B列    C列    D列    E列
1行    C101     aaa    bbb    ccc    ddd
2行    C102     aaa    bbb    ccc    ddd
3行    C103     aaa    bbb    ccc    ddd
4行    R101     eee    fff    ggg    hhh
5行    R102     eee    fff    ggg    hhh
6行    R103     eee    fff    ggg    hhh
7行    R104     eee    fff    ggg    hhh
以下同様
という表にしたいです。
書き込みしたマクロですと商品名などの所がうまく展開できません><
どうかお願いします。
補足がまだございましたらおっしゃってください。
出来る限り早く回答致します。

投稿日時 - 2011-09-02 14:19:24

あなたにオススメの質問