エクセルでこんな表を自動的に作りたいです

質問

エクセルで下記のような停止値一覧表があります。

<停止値一覧>
記号　　停止値
a　　　　3
b　　　　2
c　　　　5
d　　　　4
e　　　　10

上記のデータを元にして、下記のような記号別の連番表を別シートに自動的に作りたいのです。。。

<連番表>
No　　記号
0　　　a
1　　　a
2　　　a
0　　　b
1　　　b
0　　　c
1　　　c
2　　　c
3　　　c
4　　　c
0　　　d

連番表の「No」は連続データで、
・開始値＝ゼロ、
・停止値＝<停止値一覧>の停止値からマイナス１した値、
・増分＝１
です。

関数で簡単に出来ますでしょうか？それともマクロか何かになるのでしょうか..？
分かりにくい説明で恐縮ですが、いい方法をお分かりの方、助けて頂けないでしょうか。
よろしくお願いします。

追記：エクセルは２００２を使用しています

回答No.5

imogasi

ちょっと変わった、ＶＬＯＯＫＵＰ関数の利用でできましたので上げます。
Ｓｈｅｅｔ１のＡ１：Ｂ６に
記号　　停止値
a　　　　3
b　　　　2
c　　　　5
d　　　　4
e　　　　10
のデータがあるとします。
Ｓｈｅｅｔ２のどの列でも良いが、Ｇ，Ｈ列として
Ｇ１に０、Ｇ２に=SUM(Sheet1!$B$2:B2)と入れて、Ｇ６まで式を複写します。
Ｈ１に=Sheet1!A2と入れて下にＨ６まで式を複写します。
Ｇ列　　Ｈ列
0 a
3 b
5 c
10 d
14 e
24
となります。
Ｓｈｅｅｔ２のＡ２に
=VLOOKUP(ROW()-2,$G$1:$H$6,2,TRUE)　と入れて
第２５行（２４＋１）まで式を複写します。
Ｓｈｅｅｔ２のＢ２に=COUNTIF($A$2:A2,A2)-1と入れて下方向に
式を複写します。
（結果）
a 0
a 1
a 2
b 0
b 1
c 0
c 1
c 2
c 3
c 4
d 0
d 1
d 2
d 3
e 0
以下略
番号と記号が逆になりましたが、列入れ替えはやさしいです。
ーーーー
ＶＢＡでもこんなに少ないステップでで来ますよ。
Sub test01()
d = Worksheets("Sheet1").Range("a65536").End(xlUp).Row '最下行
k = 2 '結果シートの開始行
For i = 2 To d
For j = 1 To Worksheets("Sheet1").Cells(i, "B")
Worksheets("sheet3").Cells(k, "A") = j - 1 '連番
Worksheets("sheet3").Cells(k, "b") = Worksheets("Sheet1").Cells(i, "A") '記号
k = k + 1 '結果シートの行を進める
Next j
Next i
End Sub

回答No.4

sige1701

関数の回答がないので、作ってみました

Sheet2のA2に0を入力

Sheet2のA3に
=IF(SUM(Sheet1!B:B)<ROW(A2),"",IF(SUM(Sheet1!$B$2:INDEX(Sheet1!$B$2:$B$6,COUNTIF($A$2:A2,0)))<ROW(A2),0,A2+1))
といれ　下にコピー

Sheet2のB2に
=IF(A2="","",INDEX(Sheet1!$A$2:$A$6,COUNTIF($A$2:A2,0)))
といれ　下にコピー

回答No.3

noname#22222

Option Explicit

Private Sub CommandButton1_Click()
　　自動連番 Worksheets(1), Worksheets(2), 1, 1, 1, 1
End Sub

Option Explicit

Public Sub 自動連番(ByVal S1 As Worksheet, _　<--- どのシートから
　　　　　　　　　　　　 ByVal S2 As Worksheet, _　<--- どのシートへ
　　　　　　　　　　　　 ByVal F_R As Integer, _　<--- どの行の
　　　　　　　　　　　　 ByVal F_C As Integer, _　<--- どの列から
　　　　　　　　　　　　 ByVal T_R As Integer, _　<--- どの行の
　　　　　　　　　　　　 ByVal T_C As Integer)　<--- どの列へ
　　Dim I As Integer
　　Dim N As Integer
　　Dim M As Integer
　　Dim L As Integer
　　Dim J As Integer

　　M = T_R - 1
　　Do
　　　　If Len(S1.Cells(F_R, F_C) & "") > 0 Then
　　　　　　N = S1.Cells(F_R, F_C + 1)
　　　　　　L = M + N - 1
　　　　　　J = 0
　　　　　　For I = M To L
　　　　　　　　S2.Cells(T_R + I, T_C) = J
　　　　　　　　S2.Cells(T_R + I, T_C + 1) = S1.Cells(F_R, F_C)
　　　　　　　　J = J + 1
　　　　　　Next I
　　　　　　M = M + N
　　　　　　F_R = F_R + 1
　　　　Else
　　　　　　Exit Do
　　　　End If
　　Loop Until (False)
End Sub

※Excel門外漢ですので、これ位しか思い付きません。

回答No.2

mz80

VBAでこんな感じではだめですか

Sub TeisiToRenBan()
Dim Gyo, KigoClm, TeisiClm As Integer
Dim SheetNm As String
Dim OutSheetNm As String
Dim OutGyo, OutNoClm, OutKigoClm As Integer
Dim OutNoNm, OutKigoNm As String
Dim wkKigo
Dim wkTeisi As Integer
Dim i As Integer

SheetNm = "停止値一覧"
OutSheetNm = "連番表"
Gyo = 2
KigoClm = 1
TeisiClm = 2
OutGyo = 1
OutNoClm = 1
OutKigoClm = 2
OutNoNm = "No."
OutKigoNm = "記号"

Worksheets(OutSheetNm).Cells(OutGyo, OutNoClm) = OutNoNm
Worksheets(OutSheetNm).Cells(OutGyo, OutKigoClm) = OutKigoNm
OutGyo = OutGyo + 1
While Not IsEmpty(Worksheets(SheetNm).Cells(Gyo, KigoClm).Value)
'1行分データ取得
wkKigo = Worksheets(SheetNm).Cells(Gyo, KigoClm).Value
wkTeisi = Worksheets(SheetNm).Cells(Gyo, TeisiClm).Value

'1行分データを書き込むループ
For i = 0 To (wkTeisi - 1)
Worksheets(OutSheetNm).Cells(OutGyo, OutNoClm) = i
Worksheets(OutSheetNm).Cells(OutGyo, OutKigoClm) = wkKigo

OutGyo = OutGyo + 1
Next i
Gyo = Gyo + 1
Wend
End Sub

回答No.1

noname#123709

VBAならこんな感じでしょうか？
一例をどうぞ
Sub test()
Dim i As Long, j As Long, w As Long
With Sheets("停止値一覧")
For i = 1 To .Range("B65536").End(xlUp).Row
w = 0
For j = 1 To .Cells(i, 2).Value
Sheets("連番表").Range("B65536").End(xlUp).Offset(1).Value = .Cells(i, 1).Value
Sheets("連番表").Range("B65536").End(xlUp).Offset(, -1).Value = w
w = w + 1
Next j
Next i
End With
End Sub