Excel VBA質問箱 IV

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

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


39895 / 76738 ←次へ | 前へ→

【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列に番号を振っています。
確認してみてください。
0 hits

【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 お礼

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