Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6977 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【41903】自動で番号を振るには ｄ46 06/8/25(金) 18:01 質問[未読]
【41908】Re:自動で番号を振るには かみちゃん 06/8/25(金) 19:51 発言[未読]
【41947】Re:自動で番号を振るには ichinose 06/8/26(土) 16:51 発言[未読]
【41964】補足です。 ｄ46 06/8/27(日) 10:35 発言[未読]
【41966】Re:自動で番号を振るには（ツリー形式の階... かみちゃん 06/8/27(日) 10:58 発言[未読]
【41976】Re:補足です。 [名前なし] 06/8/27(日) 17:09 発言[未読]
【41978】Re:補足です。 ｄ46 06/8/27(日) 20:18 発言[未読]
【41979】Re:自動で番号を振るには（ツリー形式の階... かみちゃん 06/8/27(日) 20:27 発言[未読]
【41980】Re:自動で番号を振るには（ツリー形式の階... ichinose 06/8/27(日) 21:34 発言[未読]
【41985】すごいです！！ ｄ46 06/8/28(月) 9:28 お礼[未読]
【41988】再度質問 ｄ46 06/8/28(月) 13:06 質問[未読]
【41995】Re:再度質問 ｄ46 06/8/28(月) 16:14 発言[未読]
【42002】Re:再度質問 ichinose 06/8/28(月) 20:03 発言[未読]
【42007】[41980]の返答です。 ｄ46 06/8/29(火) 8:39 発言[未読]
【42012】Re:[41980]の返答です。 ichinose 06/8/29(火) 9:49 発言[未読]
【42013】Re:[41980]の返答です。 ｄ46 06/8/29(火) 10:14 お礼[未読]
【41903】自動で番号を振るには
質問  ｄ46  - 06/8/25(金) 18:01 -
引用なし
パスワード
   A列に番号が振ってあり規則に従いB列に番号(文字列)を振りたいのです。
（A列が空白セルの場合もあります。）
A列　B列
1　　001
2　　001001
　　 001001001
　　 001001002
2　　001002
3　　001002001
　　 001002001001
1　　002
2　　002001
可能でしょうか？
わかる方教えて下さい。
【41908】Re:自動で番号を振るには
発言  かみちゃん  - 06/8/25(金) 19:51 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>A列に番号が振ってあり規則に従いB列に番号(文字列)を振りたいのです。

その規則とは何ですか？説明していただけないでしょうか？
【41947】Re:自動で番号を振るには
発言  ichinose  - 06/8/26(土) 16:51 -
引用なし
パスワード
   こんにちは。

>>A列に番号が振ってあり規則に従いB列に番号(文字列)を振りたいのです。

>その規則とは何ですか？説明していただけないでしょうか？
と　かみちゃんさんがおっしゃっているように

例が一つでは足りないくらい規則が複雑ですよね！！

暇な土曜日だったのでわからない仕様は独断と偏見で決めましたが、

こういう場合は、最低３つは例を上げてくださいね。

新規ブックの標準モジュールに

'==================================================================
Sub main()
　　Dim g0 As Long
　　Dim ans As Variant
　　Dim rng As Range
　　With ActiveSheet
　　　 .Range("a:a").NumberFormatLocal = "G/標準"
　　　 .Range("b:b").NumberFormatLocal = "@"
　　　 .Range("a1:a9").Value = _
　　　　　　　Application.Transpose(Array(1, 2, "", "", 2, 3, "", 1, 2))
　　　 .Range("b:b").Value = ""
　　　 g0 = 1
　　　 Call open_nestnum(.Range("a1:a9"))
　　　 ans = get_nestnum
　　　 Do Until ans = ""
　　　　　.Range("a1:a9").Cells(g0).Offset(0, 1).Value = ans
　　　　　g0 = g0 + 1
　　　　　ans = get_nestnum
　　　　　Loop
　　　 Call close_nestnum
　　　 MsgBox "例1 確認してください"
　　　 .Range("a1:a10").Value = _
　　　　　　　Application.Transpose(Array(1, 2, "", "", 1, 2, "", "", 2, ""))
　　　 .Range("b:b").Value = ""
　　　 g0 = 1
　　　 Call open_nestnum(.Range("a1:a10"))
　　　 ans = get_nestnum
　　　 Do Until ans = ""
　　　　　.Range("a1:a10").Cells(g0).Offset(0, 1).Value = ans
　　　　　g0 = g0 + 1
　　　　　ans = get_nestnum
　　　　　Loop
　　　 Call close_nestnum
　　　 MsgBox "例2 確認してください"
　　　 End With
End Sub


別の標準モジュールに

'=====================================================================
Dim lblcnum() As Long '各レベルの数値
Dim f_val As Long　　 '初期値
Dim d_keta As Long　　'数値表示桁数
Dim clbl As Long　　　'現在の最終レベル
Dim inidx As Long　　 '配列inarray()のカレントポインタ
Dim inarray() As Variant 'レベル指示配列
Dim sb_lbl As Boolean
'↑配列inarray()の空白の連続性を示す 　True 一つ前の要素も空白　False　一つ前の要素も空白ではない
'=====================================================================
Sub open_nestnum(rng As Range, Optional ByVal f_value As Long = 1, Optional ByVal kt As Long = 3)
'　索引的数値配置処理の内部データの初期化
'　Input:　rng
'　　　 レベル指示を格納したセル範囲
'　　　（ただし、一つの行、または、列に存在する連続したセル範囲に限る)
'　　　 例　A1:A5　　a1:z1
'　　　　f_value　 レベルの初期数値（規定値　1）
'　　　　kt　　　　各レベルの表示桁数（規定値3）3の場合、
'　　　　　　　　 001　002というような3桁表示になる
　　Dim g0 As Long
　　Erase lblcnum()
　　Erase inarray()
　　ReDim inarray(1 To rng.Count)
　　For g0 = 1 To rng.Count
　　　 inarray(g0) = rng.Cells(g0).Value
　　　 Next
　　f_val = f_value
　　d_keta = kt
　　clbl = 0
　　inidx = 1
　　sb_lbl = False
End Sub
'=====================================================================
Sub close_nestnum()
'　索引的数値配置処理の終了処理　内部で使用している配列の初期化
　　Erase lblcnum()
　　Erase inarray()
　　f_val = 0
　　d_keta = 0
　　clbl = 0
　　inidx = 0
End Sub
'=====================================================================
Function get_nestnum() As Variant
'配列inarray()の指示による索引的数値配置を返す
'　input なし
'　get_nestnum 索引的数値配置　""の場合、データの終わり
　　On Error Resume Next
　　Dim g0 As Long
　　Dim wk As Long
　　get_nestnum = ""
　　If inidx <= UBound(inarray()) Then
　　　 If IsNumeric(inarray(inidx)) And inarray(inidx) <> "" Then
　　　　　sb_lbl = False
　　　　　wk = lblcnum(inarray(inidx))
　　　　　If Err.Number <> 0 Then
　　　　　　 ReDim Preserve lblcnum(1 To inarray(inidx))
　　　　　　 For g0 = LBound(lblcnum()) To UBound(lblcnum())
　　　　　　　　If lblcnum(g0) = 0 Then
　　　　　　　　　 lblcnum(g0) = f_val
　　　　　　　　　 End If
　　　　　　　　Next
　　　　　　 clbl = inarray(inidx)
　　　　　Else
　　　　　　 If inarray(inidx) <= clbl Then
　　　　　　　　lblcnum(inarray(inidx)) = wk + 1
　　　　　　 Else
　　　　　　　　lblcnum(inarray(inidx)) = f_val
　　　　　　　　End If
　　　　　　
　　　　　　
　　　　　　 clbl = inarray(inidx)
　　　　　　 End If
　　　 Else
　　　　　If sb_lbl = False Then
　　　　　　 clbl = clbl + 1
　　　　　　 End If
　　　　　wk = lblcnum(clbl)
　　　　　If Err.Number <> 0 Then
　　　　　　 ReDim Preserve lblcnum(1 To clbl)
　　　　　　 For g0 = LBound(lblcnum()) To UBound(lblcnum())
　　　　　　　　If lblcnum(g0) = 0 Then
　　　　　　　　　 lblcnum(g0) = f_val
　　　　　　　　　 End If
　　　　　　　　Next
　　　　　Else
　　　　　　 If sb_lbl = True Then
　　　　　　　　lblcnum(clbl) = wk + 1
　　　　　　 Else
　　　　　　　　lblcnum(clbl) = f_val
　　　　　　　　
　　　　　　　　End If
　　　　　　 End If
　　　　　sb_lbl = True
　　　　　End If
　　　 get_nestnum = ""
　　　 For g0 = 1 To clbl
　　　　　get_nestnum = get_nestnum & Format(lblcnum(g0), String(d_keta, "0"))
　　　　　Next
　　　 inidx = inidx + 1
　　　 End If
End Function


として、mainを実行してください。

２種類のＡ列の例から、Ｂ列に番号を振っています。
確認してみてください。
【41964】補足です。
発言  ｄ46  - 06/8/27(日) 10:35 -
引用なし
パスワード
   お答え頂いて有難うございます。
早速ためしてみます。

さて、例が足りないとこ事でしたので、もう少し記入してみます。
やりたい事：マクロでツリー形式の番号を振りたい。
　　　　　　イメージはフォルダの中にフォルダがありその中にファイルが
　　　　　　あるみたいなイメージです。
条件：Ａ列に1、2、3、…の数字が入っており規則に従いＢ列に番号を振る
(例)
Ａ列　Ｂ列
1　　1階層目(001)
2　　上記階層の中にもう1つ階層(001001)
　　 Ａ列に番号がなければ1つ階層をふやして連番にしていく(001001001)
　　 上記の連番(001001002)
1　　2回目の1なので002となる(002)
2　　今度は002に001を付加する(002001)
3　　さらに階層を増やす(002001001)
　　 Ａ列番号無し(002001001001)
1　　003
2　　003001
　　 003001001
2　　003002　　　 ←1の下に2が複数あれば2個目の階層が連番になる
2　　003003

もちろんＡ列の番号は1,2,3,4,5,6,7,8…となることもあります。
もし、上記条件が無理ならしょうがないですね。
【41966】Re:自動で番号を振るには（ツリー形式の...
発言  かみちゃん  - 06/8/27(日) 10:58 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>早速ためしてみます。
>
>さて、例が足りないとこ事でしたので、もう少し記入してみます。
>やりたい事：マクロでツリー形式の番号を振りたい。
>　　　　　　イメージはフォルダの中にフォルダがありその中にファイルが
>　　　　　　あるみたいなイメージです。
>条件：Ａ列に1、2、3、…の数字が入っており規則に従いＢ列に番号を振る

[#41947]のichinoseさんが提示されたコードのうちmainプロシージャを一部修正さ
せていただくと以下のような感じのもので動くようです。
確認してみてください。

Sub main()
　　Dim g0 As Long
　　Dim ans As Variant
　　Dim rng As Range
　　With ActiveSheet
　　　 .Range("a:a").NumberFormatLocal = "G/標準"
　　　 .Range("b:b").NumberFormatLocal = "@"
'　　　 .Range("a1:a9").Value = _
　　　　　　　Application.Transpose(Array(1, 2, "", "", 2, 3, "", 1, 2))
　　　 .Range("b:b").Value = ""
　　　 g0 = 1
'　　　 Call open_nestnum(.Range("a1:a9"))
　　　 Call open_nestnum(.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)))
　　　 ans = get_nestnum
　　　 Do Until ans = ""
'　　　　　.Range("a1:a9").Cells(g0).Offset(0, 1).Value = ans
　　　　　.Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).Cells(g0).Offset(0, 1).Value = ans
　　　　　g0 = g0 + 1
　　　　　ans = get_nestnum
　　　　　Loop
　　　 Call close_nestnum
　　　 MsgBox "例1 確認してください"
'　　　 .Range("a1:a10").Value = _
'　　　　　　　Application.Transpose(Array(1, 2, "", "", 1, 2, "", "", 2, ""))
'　　　 .Range("b:b").Value = ""
'　　　 g0 = 1
'　　　 Call open_nestnum(.Range("a1:a10"))
'　　　 ans = get_nestnum
'　　　 Do Until ans = ""
'　　　　　.Range("a1:a10").Cells(g0).Offset(0, 1).Value = ans
'　　　　　g0 = g0 + 1
'　　　　　ans = get_nestnum
'　　　　　Loop
'　　　 Call close_nestnum
'　　　 MsgBox "例2 確認してください"
　　End With
End Sub
【41976】Re:補足です。
発言  [名前なし]  - 06/8/27(日) 17:09 -
引用なし
パスワード
   >(例)
>Ａ列　Ｂ列
>1　　1階層目(001)
>2　　上記階層の中にもう1つ階層(001001)
>　　 Ａ列に番号がなければ1つ階層をふやして連番にしていく(001001001)
>　　 上記の連番(001001002)
>1　　2回目の1なので002となる(002)
>2　　今度は002に001を付加する(002001)
>3　　さらに階層を増やす(002001001)
>　　 Ａ列番号無し(002001001001)
>1　　003
>2　　003001
>　　 003001001
>2　　003002　　　 ←1の下に2が複数あれば2個目の階層が連番になる
>2　　003003

A列の最終行は必ず数値が入った状態なのでしょうか？
つまり、

A列　B列
1
2


2
3

となっていた場合、見た目にはA列最終行は「3」ですが、
実際は範囲に、

A列　B列
1　　001
2　　001001
　　 001001001
　　 001001002
2　　001002
3　　001002001
　　 001002001001
　　 001002001002

のように、「A列の番号無し」が最後にいくつか含まれるということは
無いのですか？
あと、

A列　B列
1

2

3

2

1

となっていた場合、B列の結果はどうなるのが正しいのでしょうか？
【41978】Re:補足です。
発言  ｄ46  - 06/8/27(日) 20:18 -
引用なし
パスワード
   最終行は考えていませんでした。
最終のセルにはＥＮＤと入れようかと思います。

A列　B列
1　　001
　　 002
2　　002001
　　 002001001
3　　002001002　　←空白行の下の上位Ａ列以下の番号の場合は階層を増やさない
　　 002001002001
2　　002001003
　　 002001003001
1　　003

Ｂ列は上記となるようにしたいです。
不明点が多くてすいません。
【41979】Re:自動で番号を振るには（ツリー形式の...
発言  かみちゃん  - 06/8/27(日) 20:27 -
引用なし
パスワード
   こんにちは。かみちゃん　です。

>最終行は考えていませんでした。
>最終のセルにはＥＮＤと入れようかと思います。

END対応は、未確認ですが、
[#41966]は確認していただけていないのですか？
【41980】Re:自動で番号を振るには（ツリー形式の...
発言  ichinose  - 06/8/27(日) 21:34 -
引用なし
パスワード
   ▼かみちゃん さん：
こんばんは。
ちょっと前にコードを整理して再投稿したのですが、
新たな例の御提示↓があったので一度削除しました。

>
>A列　B列
>1　　001
>　　 002
Ａ列の数字が1でその次の行が空白行のときは、
数字の並べ方の規則が数字が１以外のときの規則とは
違うということですか？


>2　　002001
>　　 002001001
>3　　002001002　　←空白行の下の上位Ａ列以下の番号の場合は階層を増やさない
　　　　　　　　　この↑コメントの意味がわかりづらいのですが・・・。
>　　 002001002001
>2　　002001003
　　↑は、002002だと思っていましたが、どのような規則で002001003となるのか
　　説明してください
>　　 002001003001
>1　　003
>
>Ｂ列は上記となるようにしたいです。

それと、
　　　　Ａ　　　Ｂ
　１　　1
　２
　３　　2
　４
　５　　3
　６
　７　　4
　８
　９　　2
１０
１１　　1


というＡ列のデータでは、Ｂ列に数字はどのように配置されますか？

それと出来れば、例を他に2,3例は記述してください
【41985】すごいです！！
お礼  ｄ46  - 06/8/28(月) 9:28 -
引用なし
パスワード
   ｽﾐﾏｾﾝ昨日まで確認出来る環境がなかったので、今日確認しました。
[41947]及び[41966]の組合わせで確認しましたところ･･･
お･おー！！。かるく感動をおぼえました。

最終行の問題はあるのですが、その他の動作は完璧みたいです。
もっと使い込んで、色々なパターンを試してみます。

かみちゃんさん、ichinoseさん
どうも有難う御座いました。
なるべく自分で組めるように勉強しますが、
またどうしても判らない時は宜しくお願いします。
【41988】再度質問
質問  ｄ46  - 06/8/28(月) 13:06 -
引用なし
パスワード
   任意で最初の初期値を変更することは出来るのでしょうか？
現在
A列　B列
1　　001
2　　001001
ですが、
A列　B列
1　　005
2　　005001
という事は可能でしょうか？
参考書片手に解読していますが？？？です。
任意の初期値設定はソース上にて行えるとありがたいです。
【41995】Re:再度質問
発言  ｄ46  - 06/8/28(月) 16:14 -
引用なし
パスワード
   こんにちわｄ46です。

[41947]のFunction get_nestnum()の処理に

Function get_nestnum() As Variant
'配列inarray()の指示による索引的数値配置を返す
'　input なし
'　get_nestnum 索引的数値配置　""の場合、データの終わり
　　On Error Resume Next
　　Dim g0 As Long
　　Dim wk As Long
　　get_nestnum = ""

　　'初期値変更処理
　　If flg = 0 Then
　　　　f_val = f_val + 0　　'初回のみ初期値を変える005スタートの場合4にする
　　　　flg = 1　　　　　　　'初回フラグON
　　ElseIf flg = 1 Then　　　'2回目の場合
　　　　f_val = f_val - 0　　'初回プラスした値を無効にする
　　　　flg = 2　　　　　　　'2回目フラグON
　　End If

と処理を入れたら出来ましたけど、なんともかっこ悪いです。。
【42002】Re:再度質問
発言  ichinose  - 06/8/28(月) 20:03 -
引用なし
パスワード
   ▼ｄ46 さん：
こんばんは。

>任意で最初の初期値を変更することは出来るのでしょうか？


>現在
>A列　B列
>1　　001
>2　　001001
>ですが、
>A列　B列
>1　　005
>2　　005001
>という事は可能でしょうか？
>参考書片手に解読していますが？？？です。
これは、出来ます。初期値を与えるインターフェースをどうするかを決めれば
そんなに難しいことではありません。

それより、

[#41980]

で記述した私からの質問に答えてください。

>>A列　B列
>>1　　001
>>　　 002
>Ａ列の数字が1でその次の行が空白行のときは、
>数字の並べ方の規則が数字が１以外のときの規則とは
>違うということですか？

この例以前の例に倣えば、
>>1　　001
　　　 001001
となると思いますが、Ａ列が1の場合、次行が空白だったら、002となるということは
他の数字とは違うということですか？
現状の私のコードでは、これは、001001となります。

>2　　002001
>　　 002001001
>3　　002001002　　←空白行の下の上位Ａ列以下の番号の場合は階層を増やさない
　　　　　　　　　この↑コメントの意味がわかりづらいのですが・・・。
これも説明していただいていません
>　　 002001002001
>2　　002001003
　　↑は、002002だと思っていましたが、どのような規則で002001003となるのか
　　説明してください
これも現状のコードでは、002002となります。

>　　 002001003001
>1　　003


それと、
　　　　Ａ　　　Ｂ
　１　　1
　２
　３　　2
　４
　５　　3
　６
　７　　4
　８
　９　　2
１０
１１　　1

これも回答と解説をしてください。


これを回答していただかないと

先には進めませんよ。
初期値の設定などより、先に解決しなければならないことだと
思います。
【42007】[41980]の返答です。
発言  ｄ46  - 06/8/29(火) 8:39 -
引用なし
パスワード
   ▼ichinose さん：
こんにちわ。
返答が遅くなってスイマセン。

>>>A列　B列
>>>1　　001
>>>　　 002
>>Ａ列の数字が1でその次の行が空白行のときは、
>>数字の並べ方の規則が数字が１以外のときの規則とは
>>違うということですか？
>
>この例以前の例に倣えば、
>>>1　　001
>　　　 001001
>となると思いますが、Ａ列が1の場合、次行が空白だったら、002となるということは
>他の数字とは違うということですか？
>現状の私のコードでは、これは、001001となります。
スイマセン、私の記述が間違っていました。
A列　B列
1　　001
　　 001001
が正解です。

>>2　　002001
>>　　 002001001
>>3　　002001002　　←空白行の下の上位Ａ列以下の番号の場合は階層を増やさない
>　　　　　　　　　この↑コメントの意味がわかりづらいのですが・・・。
A列の空白行の次の番号3があってもすでに階層は3階層目だから002001002001とは
ならないよということです。わかりづらくてスイマセン
(提示していただいたソースの動きで正解です)

>>　　 002001002001
>>2　　002001003
>　　↑は、002002だと思っていましたが、どのような規則で002001003となるのか
>　　説明してください
>これも現状のコードでは、002002となります。
スイマセンこれも私のミスです002002となるのが正解です。

>それと、
>　　　　Ａ　　　Ｂ
>　１　　1　　　 001
>　２　　　　　　001001
>　３　　2　　　 001002
>　４　　　　　　001002001
>　５　　3　　　 001002002
>　６　　　　　　001002002001
>　７　　4　　　 001002002002
>　８　　　　　　001002002002001
>　９　　2　　　 001003
>１０　　　　　　001003001
>１１　　1　　　 002
となります。
【42012】Re:[41980]の返答です。
発言  ichinose  - 06/8/29(火) 9:49 -
引用なし
パスワード
   ▼ｄ46 さん
おはようございます。

これで安心しました。

再投稿です。

新規ブックの標準モジュールに
'============================================================
Option Explicit
Sub main()
　　Dim g0 As Long
　　Dim ans As Variant
　　Dim rng As Range
　　ReDim 初期値(1 To 1) As Long
　　Set rng = Range("a1", Cells(Rows.Count, "a").End(xlUp))
　　Set rng = rng.Resize(rng.Rows.Count - 1)
　　With rng
　　　 .Offset(0, 1).NumberFormatLocal = "@"
　　　 .Offset(0, 1).Value = ""
　　　 End With
　　g0 = 1
　　初期値(1) = 5 '初期値の設定
　　Call open_nestnum(rng, 初期値())
　　ans = get_nestnum
　　Do Until ans = ""
　　　 rng.Cells(g0).Offset(0, 1).Value = ans
　　　 g0 = g0 + 1
　　　 ans = get_nestnum
　　　 Loop
　　Call close_nestnum
End Sub

別の標準モジュールに

'===============================================================
Option Explicit
Dim lblcnum() As Long '各レベルの数値
Dim f_val As Variant　 '初期値の配列
Dim d_keta As Long　　'数値表示桁数
Dim clbl As Long　　　'現在の最終レベル
Dim inidx As Long　　 '配列inarray()のカレントポインタ
Dim inarray() As Variant 'レベル指示配列
Dim sb_lbl As Boolean
'↑配列inarray()の空白の連続性を示す 　True 一つ前の要素も空白　False　一つ前の要素も空白ではない
'===============================================================
Sub open_nestnum(rng As Range, Optional ByVal f_value As Variant = 1, Optional ByVal kt As Long = 3)
'　索引的数値配置処理の内部データの初期化
'　Input:　rng
'　　　 レベル指示を格納したセル範囲
'　　　（ただし、一つの行、または、列に存在する連続したセル範囲に限る)
'　　　 例　A1:A5　　a1:z1
'　　　　f_value　 レベルの初期数値を配列で指定する　　f_value(1)　　レベル1の初期値　f_value(2)　　レベル2の初期値
'　　　　　　　　 省略すると　全て1が初期値
'　　　　kt　　　　各レベルの表示桁数（規定値3）3の場合、
'　　　　　　　　 001　002というような3桁表示になる
　　Dim g0 As Long
　　Erase lblcnum()
　　Erase inarray()
　　ReDim inarray(1 To rng.Count)
　　For g0 = 1 To rng.Count
　　　 inarray(g0) = rng.Cells(g0).Value
　　　 Next
　　If TypeName(f_value) = "Integer" Then
　　　 f_value = Array(0, 1)
　　　 End If
　　f_val = f_value
　　d_keta = kt
　　clbl = 0
　　inidx = 1
　　sb_lbl = False
End Sub
'===============================================================
Sub close_nestnum()
'　索引的数値配置処理の終了処理　内部で使用している配列の初期化
　　Erase lblcnum()
　　Erase inarray()
　　f_val = 0
　　d_keta = 0
　　clbl = 0
　　inidx = 0
　　sb_lbl = False
End Sub
'===============================================================
Function get_nestnum() As Variant
'配列inarray()の指示による索引的数値配置を返す
'　input なし
'　get_nestnum 索引的数値配置　""の場合、データの終わり
　　On Error Resume Next
　　Dim g0 As Long
　　Dim d_data As Variant
　　Dim wk As Long
　　get_nestnum = ""
　　If inidx <= UBound(inarray()) Then
　　　 d_data = Val(inarray(inidx))
　　　 If d_data > 0 Then
　　　　　sb_lbl = False
　　　 Else
　　　　　If sb_lbl = False Then
　　　　　　 d_data = clbl + 1
　　　　　Else
　　　　　　 d_data = clbl
　　　　　　 End If
　　　　　sb_lbl = True
　　　　　End If
　　　 ReDim Preserve lblcnum(1 To d_data)
　　　 For g0 = LBound(lblcnum()) To UBound(lblcnum())
　　　　　If lblcnum(g0) = 0 Then
　　　　　　 Err.Clear
　　　　　　 wk = f_val(g0)
　　　　　　 If Err.Number <> 0 Then
　　　　　　　　wk = 1
　　　　　　　　End If
　　　　　　 lblcnum(g0) = wk
　　　　　　 End If
　　　　　Next
　　　 If d_data <= clbl Then
　　　　　lblcnum(d_data) = lblcnum(d_data) + 1
　　　 Else
　　　　　Err.Clear
　　　　　wk = f_val(d_data)
　　　　　If Err.Number <> 0 Then
　　　　　　 wk = 1
　　　　　　 End If
　　　　　lblcnum(d_data) = wk
　　　　　End If
　　　 clbl = d_data
　　　 For g0 = 1 To clbl
　　　　　get_nestnum = get_nestnum & _
　　　　　　　Format(lblcnum(g0), String(d_keta, "0"))
　　　　　Next
　　　 inidx = inidx + 1
　　　 End If
End Function


としてください。


アクティブシートのデータが

　　　　　　　Ａ　　　　Ｂ
　１　　　　　1
　２　　　　　2
　３　　　　　
　４　　　　　1
　５　　　　End

このようなデータで
　　　　　Ａ　　　Ｂ
　１　　　1　　　005
　２　　　2　　　005001
　３　　　　　　 005001001
　４　　　1　　　006
　５　　　end

となります。
（必ず、最終行を示す「end」を入れること）


確認してください。

尚、この後の投稿は夜以降になってしまいます。
【42013】Re:[41980]の返答です。
お礼  ｄ46  - 06/8/29(火) 10:14 -
引用なし
パスワード
   こんばんわｄ46です。
ichinoseさん早速の返信有難うございます。
Newソースで確認しましたが、完璧です！！
何度もお手数お掛けしました。
またお世話になることがあるかもしれませんが、その時はまた宜しくお願いします。

有難うございました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6977 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free