セル内の数字の数、セルを分割させたい

質問

こんにちは。
以下のようなことをしたいときに、使える関数またはマクロがあればお助け頂けないでしょうか。

シート1には名前列(A列)と個数列(B列)があります。

Aさん,3
Bさん,2
Cさん,1
・
・
・

というイメージです。

次にシート2に以下のように表を作成したいです。

Aさん
Aさん
Aさん
Bさん
Bさん
Cさん
・
・
・

シート１の個数列にある数字の数の分セルを作成し、
且つそこに氏名を入れたいです。

手作業でやるには人数が多すぎ、困っております。
何かの関数でできないかと色々試そうとしていますが、
良い案が浮かびません。

お力をお貸し頂けると大変助かります。
よろしくおねがいします。

回答No.4

Chiquilin

> 使える関数またはマクロがあれば
関数もマクロもどこかに転がっている訳じゃありません。「ありますか」という訊き方
はどうかと思います。この処理ができないということは おそらく VBAの知識は皆無で
すよね？　「できないからマクロ」という発想は捨てて欲しいと思います。

......A.......B....C.......D........E
1...氏名...回数...6...行番号...氏名
2...Aさん...3.....3......2.....Aさん
3...Bさん...2.....1......2.....Aさん
4...Cさん...1.....0......2.....Aさん
5............................3.....Bさん
6............................3.....Bさん
7............................4.....Cさん

■C1セル
=B2+C2
C4セルまでコピー

■D2セル
=IF(C$1<ROW(D1),"",MATCH(C$1-ROW(D1)+1,C$1:C$4,-1)+1)

■E2セル
=IF(D2="","",INDEX(A:A,D2))

D2:E2セルを下方向に好きなだけコピー

回答No.3

tom04

こんばんは！

＞何かの関数でできないかと色々試そうとしていますが・・・

一案です。

↓の画像のようにSheet2のC列以降を作業用のセルとして使用します。
C1セルに
=IF(Sheet1!$B1<COLUMN(A1),"",ROW()*1000+COLUMN())
という数式を入れ、列・行方向にずぃ～～～！っと広めにフィルハンドルでコピー！

A1セルに
=IFERROR(INDEX(Sheet1!A:A,INT(SMALL($C:$Z,ROW(A1))/1000)),"")
という数式を入れフィルハンドルで下へコピー！
これで画像のような感じになります。

＞手作業でやるには人数が多すぎ
となるとやはりVBAですかね！

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻りマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub Sample1() 'この行から
Dim i As Long, wS As Worksheet
Set wS = Worksheets("Sheet2")
wS.Range("A:A").ClearContents
With Worksheets("Sheet1")
For i = 1 To .Cells(Rows.Count, "A").End(xlUp).Row
wS.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(.Cells(i, "B")) = .Cells(i, "A")
Next i
End With
wS.Rows(1).Delete
End Sub 'この行まで

※　Sheet2のA列に数式が入っている場合、マクロを実行すると数式は消えてしまいます。
別Sheetでマクロを試してみてください。m(_ _)m

回答No.2

bunjii

>何かの関数でできないかと色々試そうとしていますが、良い案が浮かびません。
関数の場合は計算途中の値を次のセルへ引き継げませんので代わりに作業用テーブルを使う方法で目的の処理が出来ます。
例えばSheet2のB列を作業用テーブルとして使用すると次のような処理になります。
Sheet2のA列の先頭はSheet1のA列の先頭とします。
Sheet2のB列の先頭はSheet1のB列の先頭の値から1を減じた値とします。
Sheet2!A1=Sheet1!A1
Sheet2!B1=Sheet1!B1-1
Sheet2!A2=IF(B1,A1,INDEX(Sheet1!A:A,MATCH(A1,Sheet1!A:A,0)+1,1))
Sheet2!B2=IF(B1,B1-1,VLOOKUP(INDEX(Sheet1!A:A,MATCH(A1,Sheet1!A:A,0)+1,1),Sheet1!A:B,2)-1)
Sheet2!A2:B2を下へ必要数コピーすれば目的通りになるでしょう。

回答No.1

keithin

マクロで行った方が簡単です。

＃まぁ、わけもわからずやらされるという意味では、マクロでも複雑な数式でも一緒かもしれませんが。。。

手順：
ＡＬＴ＋Ｆ１１を押す
現れた画面で挿入メニューから標準モジュールを挿入する
現れたシートに下記をコピー貼り付ける

sub macro1()
　dim r as long
　dim n as long
　worksheets("Sheet2").range("A:A").clearcontents
　worksheets("Sheet2").range("A1") = "NAME"

　for r = 1 to worksheets("Sheet1").range("A65536").end(xlup).row
　for n = 1 to worksheets("Sheet1").cells(r, "B").value
　　worksheets("Sheet2").range("A65536").end(xlup).offset(1) = worksheets("Sheet1").cells(r, "A").value
　next n
　next r
end sub

Sheet1のＡ，Ｂ列に、ご相談に書かれている通りに１行目からいきなりデータを記入する
Sheet2を用意する
ＡＬＴ＋Ｆ８を押してマクロを実行する。