準・究極の選択

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

<停止値一覧>
記号  停止値
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」は連続データで、
・開始値=ゼロ、
・停止値=<停止値一覧>の停止値からマイナス1した値、
・増分=1
です。

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

追記:エクセルは2002を使用しています

A 回答 (5件)

ちょっと変わった、VLOOKUP関数の利用でできましたので上げます。


Sheet1のA1:B6に
記号  停止値
a    3
b    2
c    5
d    4
e    10
のデータがあるとします。
Sheet2のどの列でも良いが、G,H列として
G1に0、G2に=SUM(Sheet1!$B$2:B2)と入れて、G6まで式を複写します。
H1に=Sheet1!A2と入れて下にH6まで式を複写します。
G列  H列
0a
3b
5c
10d
14e
24
となります。
Sheet2のA2に
=VLOOKUP(ROW()-2,$G$1:$H$6,2,TRUE) と入れて
第25行(24+1)まで式を複写します。
Sheet2のB2に=COUNTIF($A$2:A2,A2)-1と入れて下方向に
式を複写します。
(結果)
a0
a1
a2
b0
b1
c0
c1
c2
c3
c4
d0
d1
d2
d3
e0
以下略
番号と記号が逆になりましたが、列入れ替えはやさしいです。
ーーーー
VBAでもこんなに少ないステップでで来ますよ。
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
    • good
    • 0

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



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)))
といれ 下にコピー
    • good
    • 0

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門外漢ですので、これ位しか思い付きません。
    • good
    • 0

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
    • good
    • 0

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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


おすすめ情報