Excel VBA質問箱 IV

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

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


6975 / 13644 ツリー ←次へ | 前へ→

【41903】自動で番号を振るには d46 06/8/25(金) 18:01 質問[未読]
【41908】Re:自動で番号を振るには かみちゃん 06/8/25(金) 19:51 発言[未読]
【41947】Re:自動で番号を振るには ichinose 06/8/26(土) 16:51 発言[未読]
【41964】補足です。 d46 06/8/27(日) 10:35 発言[未読]
【41966】Re:自動で番号を振るには(ツリー形式の階... かみちゃん 06/8/27(日) 10:58 発言[未読]
【41976】Re:補足です。 [名前なし] 06/8/27(日) 17:09 発言[未読]
【41978】Re:補足です。 d46 06/8/27(日) 20:18 発言[未読]
【41979】Re:自動で番号を振るには(ツリー形式の階... かみちゃん 06/8/27(日) 20:27 発言[未読]
【41980】Re:自動で番号を振るには(ツリー形式の階... ichinose 06/8/27(日) 21:34 発言[未読]
【41985】すごいです!! d46 06/8/28(月) 9:28 お礼[未読]
【41988】再度質問 d46 06/8/28(月) 13:06 質問[未読]
【41995】Re:再度質問 d46 06/8/28(月) 16:14 発言[未読]
【42002】Re:再度質問 ichinose 06/8/28(月) 20:03 発言[未読]
【42007】[41980]の返答です。 d46 06/8/29(火) 8:39 発言[未読]
【42012】Re:[41980]の返答です。 ichinose 06/8/29(火) 9:49 発言[未読]
【42013】Re:[41980]の返答です。 d46 06/8/29(火) 10:14 お礼[未読]

【41903】自動で番号を振るには
質問  d46  - 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列に番号(文字列)を振りたいのです。

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

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

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

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

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

'==================================================================
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を実行してください。

2種類のA列の例から、B列に番号を振っています。
確認してみてください。

【41964】補足です。
発言  d46  - 06/8/27(日) 10:35 -

引用なし
パスワード
   お答え頂いて有難うございます。
早速ためしてみます。

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

もちろんA列の番号は1,2,3,4,5,6,7,8…となることもあります。
もし、上記条件が無理ならしょうがないですね。

【41966】Re:自動で番号を振るには(ツリー形式の...
発言  かみちゃん  - 06/8/27(日) 10:58 -

引用なし
パスワード
   こんにちは。かみちゃん です。

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

[#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 -

引用なし
パスワード
   >(例)
>A列 B列
>1  1階層目(001)
>2  上記階層の中にもう1つ階層(001001)
>   A列に番号がなければ1つ階層をふやして連番にしていく(001001001)
>   上記の連番(001001002)
>1  2回目の1なので002となる(002)
>2  今度は002に001を付加する(002001)
>3  さらに階層を増やす(002001001)
>   A列番号無し(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:補足です。
発言  d46  - 06/8/27(日) 20:18 -

引用なし
パスワード
   最終行は考えていませんでした。
最終のセルにはENDと入れようかと思います。

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

B列は上記となるようにしたいです。
不明点が多くてすいません。

【41979】Re:自動で番号を振るには(ツリー形式の...
発言  かみちゃん  - 06/8/27(日) 20:27 -

引用なし
パスワード
   こんにちは。かみちゃん です。

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

END対応は、未確認ですが、
[#41966]は確認していただけていないのですか?

【41980】Re:自動で番号を振るには(ツリー形式の...
発言  ichinose  - 06/8/27(日) 21:34 -

引用なし
パスワード
   ▼かみちゃん さん:
こんばんは。
ちょっと前にコードを整理して再投稿したのですが、
新たな例の御提示↓があったので一度削除しました。

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


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

それと、
    A   B
 1  1
 2
 3  2
 4
 5  3
 6
 7  4
 8
 9  2
10
11  1


というA列のデータでは、B列に数字はどのように配置されますか?

それと出来れば、例を他に2,3例は記述してください

【41985】すごいです!!
お礼  d46  - 06/8/28(月) 9:28 -

引用なし
パスワード
   スミマセン昨日まで確認出来る環境がなかったので、今日確認しました。
[41947]及び[41966]の組合わせで確認しましたところ・・・
お・おー!!。かるく感動をおぼえました。

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

かみちゃんさん、ichinoseさん
どうも有難う御座いました。
なるべく自分で組めるように勉強しますが、
またどうしても判らない時は宜しくお願いします。

【41988】再度質問
質問  d46  - 06/8/28(月) 13:06 -

引用なし
パスワード
   任意で最初の初期値を変更することは出来るのでしょうか?
現在
A列 B列
1  001
2  001001
ですが、
A列 B列
1  005
2  005001
という事は可能でしょうか?
参考書片手に解読していますが???です。
任意の初期値設定はソース上にて行えるとありがたいです。

【41995】Re:再度質問
発言  d46  - 06/8/28(月) 16:14 -

引用なし
パスワード
   こんにちわd46です。

[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 -

引用なし
パスワード
   ▼d46 さん:
こんばんは。

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


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

それより、

[#41980]

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

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

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

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

>   002001003001
>1  003


それと、
    A   B
 1  1
 2
 3  2
 4
 5  3
 6
 7  4
 8
 9  2
10
11  1

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


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

先には進めませんよ。
初期値の設定などより、先に解決しなければならないことだと
思います。

【42007】[41980]の返答です。
発言  d46  - 06/8/29(火) 8:39 -

引用なし
パスワード
   ▼ichinose さん:
こんにちわ。
返答が遅くなってスイマセン。

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

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

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

>それと、
>    A   B
> 1  1    001
> 2      001001
> 3  2    001002
> 4      001002001
> 5  3    001002002
> 6      001002002001
> 7  4    001002002002
> 8      001002002002001
> 9  2    001003
>10      001003001
>11  1    002
となります。

【42012】Re:[41980]の返答です。
発言  ichinose  - 06/8/29(火) 9:49 -

引用なし
パスワード
   ▼d46 さん
おはようございます。

これで安心しました。

再投稿です。

新規ブックの標準モジュールに
'============================================================
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


としてください。


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

       A    B
 1     1
 2     2
 3     
 4     1
 5    End

このようなデータで
     A   B
 1   1   005
 2   2   005001
 3       005001001
 4   1   006
 5   end

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


確認してください。

尚、この後の投稿は夜以降になってしまいます。

【42013】Re:[41980]の返答です。
お礼  d46  - 06/8/29(火) 10:14 -

引用なし
パスワード
   こんばんわd46です。
ichinoseさん早速の返信有難うございます。
Newソースで確認しましたが、完璧です!!
何度もお手数お掛けしました。
またお世話になることがあるかもしれませんが、その時はまた宜しくお願いします。

有難うございました。

6975 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free