层级序号填写

春日秋水

要求是根据所在列不同依次填写不同的层级。A列为想要的内容。

如：

1）B列不为空，如出现两次，则在序号分别填写1、2，如有3次，则填写1、2、3

2）C列的填写如B列，但要考虑B列的存在，如果同属于B列的内容，则将B列的数值带入,并中间用"."连接.其他列的填写相同。也就是带入左侧列中的数值。

案例.rar (8.25 KB, 下载次数: 16)

2017-12-7 10:22 上传

点击文件名下载附件

小花鹿

用一个数组，不为空相应位置加1，后面为空，再连起来就是层级序号

jsgj2023

楼上师傅思路真不错！

春日秋水

数组不懂，如何 做，还请说明。非常感谢

一把小刀闯天下

'满意来朵小花哈
'输出到G列，自己修改，因为你得示例中有错误，给你作比较
Option Explicit

Sub test()
  Dim i, j, arr, brr, n
  arr = Range("a2:e" & [e65536].End(xlUp).Row)
  ReDim brr(1 To UBound(arr, 1), 1 To UBound(arr, 2))
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 2)) > 0 Then n = n + 1
    brr(i, 2) = n
  Next
  n = 0
  For i = 2 To UBound(arr, 1)
    If brr(i - 1, 2) <> brr(i, 2) Then n = 0
    If Len(arr(i, 3)) > 0 Then n = n + 1
    brr(i, 3) = n
  Next
  n = 0
  For i = 3 To UBound(arr, 1)
    If brr(i - 1, 3) <> brr(i, 3) Then n = 0
    If Len(arr(i, 4)) > 0 Then n = n + 1
    brr(i, 4) = n
  Next
  n = 0
  For i = 4 To UBound(arr, 1)
    If brr(i - 1, 4) <> brr(i, 4) Then n = 0
    If Len(arr(i, 5)) > 0 Then n = n + 1
    brr(i, 5) = n
  Next
  For i = 1 To UBound(brr, 1)
    For j = 2 To UBound(brr, 2)
      brr(i, 1) = brr(i, 1) & brr(i, j)
      
    Next
    brr(i, 1) = Replace(brr(i, 1), "0", vbNullString)
  Next
  [g2].Resize(UBound(arr, 1), 1) = brr
End Sub

fyure

1. Sub test()
   
2.     　Dim arrData
   
3.     　Dim myRow%, myCol%, i%, j%, k%, s%
   
4.     　arrData = [a1].CurrentRegion
   
5.     　For myRow = 2 To UBound(arrData)
   
6.         　　For myCol = 2 To 5
   
7.             　　　If arrData(myRow, myCol) <> "" Then Exit For
   
8.         　　Next
   
9.         　　Select Case myCol
   
10.             　　Case 2
    
11.                 　　　i = i + 1
    
12.                 　　　arrData(myRow, 1) = i
    
13.                 　　　j = 0: k = 0: s = 0
    
14.             　　Case 3
    
15.                　　　j = j + 1
    
16.                　　　arrData(myRow, 1) = i & "." & j
    
17.                　　　k = 0: s = 0
    
18.             　　Case 4
    
19.                　　　k = k + 1
    
20.                　　　arrData(myRow, 1) = i & "." & j & "." & k
    
21.                　　　s = 0
    
22.             　　Case 5
    
23.                　　　s = s + 1
    
24.                　　　arrData(myRow, 1) = i & "." & j & "." & k & "." & s
    
25.             　　End Select
    
26.      　Next
    
27.      　[a1].Resize(UBound(arrData, 1), UBound(arrData, 2)) = arrData
    
28. End Sub
    

复制代码

小花鹿

Sub test()
Dim ar, br(1 To 4), i&, j&, k&
ar = [a1].CurrentRegion
For i = 2 To UBound(ar)
    For j = 2 To UBound(ar, 2)
        If ar(i, j) <> "" Then
            br(j - 1) = Val(br(j - 1)) + 1
            For k = j To 4
                br(k) = ""
            Next k
            Exit For
        End If
    Next j
    Cells(i, 1) = Replace(Trim(Join(br, " ")), " ", ".")
Next i
End Sub

春日秋水

非常感谢支持现在有一个问题，如果一级别的数值超过10个则出错

一把小刀闯天下

春日秋水 发表于 2017-12-7 12:30
非常感谢支持现在有一个问题，如果一级别的数值超过10个则出错

哈哈哈，没考虑到，自己修改一下：
  For i = 1 To UBound(brr, 1)
    For j = 2 To UBound(brr, 2)
      brr(i, 1) = brr(i, 1) & brr(i, j) & "."

    Next
    brr(i, 1) = Left(brr(i, 1), Len(brr(i, 1)) - 1)
    brr(i, 1) = Replace(brr(i, 1), ".0", vbNullString)
  Next

yjh_27

自定义函数。

内容重写
http://club.excelhome.net/thread-1383613-1-1.html
(出处: ExcelHome技术论坛)