マクロの組み方を教えてください

セルAに1000から8999までの数値があります。
セルAの配下のセルBに１から９までの数値があります。
セルBの配下のセルCに１から31の数値が入れられます。

セルCは最大数31で、現在入っているデータの個数は欠番もあるため
データの個数が１０個であっても最大の値が１０というわけではありません。

欠番のないものには最大数プラス１の値を
欠番のあるものは、その最小の欠番をセルCを参照してセルDに出したいのですが
ExcelまたはAccess（2007）でどのようなマクロを組めばいいでしょうか。

現在手動確認でやっているため、時間がかかりかつ、見落としのミスも多いです。


1000－１－１
　　　　　　　２
　　　　　　　３　　　　→４　を表示させたい。

1000ー２－１
　　　　　　　３
　　　　　　　５
　　　　　　　６　　　　→２を表示させたい。

ご指導いただけないでしょうか。

No.3 回答者： kokorone 回答日時： 2011/05/14 12:58

マクロが作れないから、質問したのですよね。

『このマクロですと、今回1個のデータの値をだせるのだと思いますが
今回5個あたいを出したい場合は』
あなたの質問に的確に答えているはずですがｌ。
プログラム中のコメントは、理解してもらうためのものです。
『今回5個あたいを出したい場合は』って、どこが分からないのですか？
私の回答を理解していますか？

とりあえず・・・・・

Dim key_data As String
Dim key_cnt As String
Dim out_cnt As Integer


Sub test1()
Dim row_max As Integer
Dim row_cnt As Integer

'出力個数読み込み(E1)
If Cells(1, 5).Value = "" Then
Exit Sub
End If
out_cnt = Cells(1, 5).Value

'最終行を求める
row_max = Range("C1").End(xlDown).Row
'欠番データ初期化
key_data = ""
key_cnt = 0
'２行目から最終行間でのループ
For row_cnt = 2 To row_max
'欠番チェック
If Cells(row_cnt, 3).Value > Cells(row_cnt - 1, 3).Value + 1 Then
'欠番データ設定
Call ketuban_set(Cells(row_cnt - 1, 3).Value + 1, Cells(row_cnt, 3).Value)
End If
'キーブレーク?
If Cells(row_cnt, 3).Value < Cells(row_cnt - 1, 3).Value + 1 Then
'欠番データ設定
Call ketuban_set(Cells(row_cnt - 1, 3).Value + 1, 10)
Cells(row_cnt - 1, 4).Value = key_data
'欠番データ初期化
key_data = ""
key_cnt = 0
If Cells(row_cnt, 3).Value > 1 Then
'欠番データ設定
Call ketuban_set(1, Cells(row_cnt, 3).Value)
End If
End If
Next row_cnt
'最終行の処理
'欠番データ設定
Call ketuban_set(Cells(row_cnt - 1, 3).Value + 1, 10)
Cells(row_cnt - 1, 4).Value = key_data
End Sub
Sub ketuban_set(min As Integer, max As Integer)
Dim cnt As Integer
For cnt = min To max - 1
'出力個数まで設定済み？
If key_cnt >= out_cnt Then
Exit For
End If
If key_cnt = 0 Then
key_data = "" & cnt
Else
key_data = key_data & "," & cnt
End If
key_cnt = key_cnt + 1
Next cnt
End Sub

今回はあえて、補足はしません。
出力個数が変化する場合は、どうしたらよいかは、プログラムから読み取ってください。

この回答へのお礼

kokorone様

詳しい回答をありがとうございます。

マクロに不慣れなため、へんな質問をしておりました。
ご気分を害されたでしょうに、丁寧なご回答までいただいて
もうしわけございません。
もっと勉強いたします。

お礼日時：2011/05/15 08:31

No.2 回答者： kokorone 回答日時： 2011/05/13 23:44

Sub test()

Dim row_max As Integer
Dim row_cnt As Integer
Dim key_data As Integer

'最終行を求める
row_max = Range("C1").End(xlDown).Row
'欠番データ初期化
key_data = -1
'２行目から最終行間でのループ
For row_cnt = 2 To row_max
'欠番チェック
If Cells(row_cnt, 3).Value > Cells(row_cnt - 1, 3).Value + 1 Then
'欠番データが初期状態ならば、欠番データ再設定
If key_data = -1 Then
key_data = Cells(row_cnt - 1, 3).Value + 1
End If
End If
'A/B列が変化?
If Cells(row_cnt, 3).Value < Cells(row_cnt - 1, 3).Value + 1 Then
'欠番データが初期状態ならば、欠番データ再設定(最大値+1)
If key_data = -1 Then
key_data = Cells(row_cnt - 1, 3).Value + 1
End If
Cells(row_cnt - 1, 4).Value = key_data
If Cells(row_cnt, 3).Value > 1 Then
key_data = 1
Else
key_data = -1
End If
End If
Next row_cnt
'最終行の処理
'欠番データが初期状態ならば、欠番データ再設定(最大値+1)
If key_data = -1 Then
key_data = Cells(row_cnt - 1, 3).Value + 1
End If
Cells(row_cnt - 1, 4).Value = key_data

End Sub

改訂版です。キーブレークした時の次の値が１以上の場合（いきなり欠番）の場合
欠番を１とします。

この回答への補足

kokorone様
ご回答ありがとうございます。

'A/B列が変化?　とありますが、A,B列は変化します。

このマクロですと、今回1個のデータの値をだせるのだと思いますが
今回5個あたいを出したい場合は
列Cに欠番がない場合は列Bの最大値＋１から順に＋２、３、４で5個です。
欠番がある場合はその小さい値から順にとり、欠番をつかいきったら現在ある値の最大値＋１となります。

1000－1－１
　　　　　２
　　　　　３　→今回５個なので、　４，５，６，７，８を出したい。

1000ー2ー１
　　　　　４
　　　　　５
　　　　　７　→今回５個なので、２、３、６、８，９を出したい。

毎回出したい個数は変わります。

こちらの条件を付加すると、どのようなマクロになるでしょうか。

　　　
　　　

補足日時：2011/05/14 10:02

No.1 回答者： kokorone 回答日時： 2011/05/13 23:37

Sub test()

Dim row_max As Integer
Dim row_cnt As Integer
Dim key_data As Integer

'最終行を求める
row_max = Range("C1").End(xlDown).Row
'欠番データ初期化
key_data = -1
'２行目から最終行間でのループ
For row_cnt = 2 To row_max
'欠番チェック
If Cells(row_cnt, 3).Value > Cells(row_cnt - 1, 3).Value + 1 Then
'欠番データが初期状態ならば、欠番データ再設定
If key_data = -1 Then
key_data = Cells(row_cnt - 1, 3).Value + 1
End If
End If
'A/B列が変化?
If Cells(row_cnt, 3).Value < Cells(row_cnt - 1, 3).Value + 1 Then
'欠番データが初期状態ならば、欠番データ再設定(最大値+1)
If key_data = -1 Then
key_data = Cells(row_cnt - 1, 3).Value + 1
End If
Cells(row_cnt - 1, 4).Value = key_data
key_data = -1
End If
Next row_cnt
'最終行の処理
'欠番データが初期状態ならば、欠番データ再設定(最大値+1)
If key_data = -1 Then
key_data = Cells(row_cnt - 1, 3).Value + 1
End If
Cells(row_cnt - 1, 4).Value = key_data

End Sub

いかがでしょうか？