按照层级添加图纸和编号信息（BOM展开）

zl201o

Hi 大家好，

截图中红色方框是需要达到的效果。


举例说明：A-501508.2>S-502823.1>S-502824.1的含义如下

希望能够输入A，B列信息后，自动执行得到C列

yylucke

Private Sub CommandButton1_Click()
    With Sheet1
        MaxR = .Cells(Rows.Count, 3).End(3).Row
        If MaxR > 1 Then .Range("C2:C" & MaxR).ClearContents
        
        MaxR = .Cells(Rows.Count, 1).End(3).Row
        arr = .Range("A2:C" & MaxR)
        .Range("A2:B" & MaxR).Sort Range("A1"), 1, , , , , , 2
        For i = 1 To UBound(arr)
            tmp级次 = Len(arr(i, 1)) - Len(Replace(arr(i, 1), ".", ""))
            If tmp级次 > 0 Then
                tmp末尾编号 = Mid(arr(i, 1), InStrRev(arr(i, 1), "."), 99)
                tmp父级 = Left(arr(i, 1), InStrRev(arr(i, 1), ".") - 1)
                k = i - 1
                Do
                    If arr(k, 1) = tmp父级 Then
                        arr(i, 3) = IIf(arr(k, 3) = "", arr(k, 2), arr(k, 3) & ">" & arr(k, 2)) & tmp末尾编号
                        Exit Do
                    End If
                    k = k - 1
                Loop While k > 0
            End If
        Next i
        .Range("C2").Resize(MaxR - 1, 1) = Application.Index(arr, , 3)
    End With
End Sub

yylucke

请参考

Test.rar (25.64 KB, 下载次数: 14)

2020-6-24 10:51 上传

点击文件名下载附件

zl201o

谢谢，很有用