整理BOM时写的关于拆分单元格的VB代码

Public Function AddRows(pos As Integer, amount As Integer)
    Dim rpos As Integer
    rpos = pos + 1
    For i = 1 To amount
        ActiveSheet.Rows(rpos).Insert
    Next i
End Function
Public Function PasteRows(startPos As Integer, amount As Integer)
    Dim rStartPos As Integer
    Dim rEndPos As Integer
    Dim startPosStr As String
    Dim endPosStr As String
    
    startPosStr = str(startPos)
    rStartPos = startPos + 1
    rEndPos = startPos + amount
    
    Rows(startPos & ":" & startPos).Select
    Selection.Copy
    Rows(startPos + 1 & ":" & rEndPos).Select
    ActiveSheet.Paste
End Function
Public Function ElementNum(str As String) As Integer
    Dim a() As String
    a = Split(str, ",")
    ElementNum = UBound(a) - LBound(a)
End Function
Public Function PasteCells(str As String, pos As Integer)
    Dim a() As String
    Dim num As Integer
    Dim i As Integer
    Dim j As Integer
    
    j = 0
    a = Split(str, ",")
    num = UBound(a) - LBound(a) + pos
    For i = pos To num
        ActiveSheet.Cells(i, 2) = a(j)
        j = j + 1
    Next i
End Function

Sub BomSplit()
    Dim rowNum As Integer
    Dim i As Integer
    Dim j As Integer
    
    j = 1
    For i = 1 To 3　　　　　　　　　　　　　　　　’按照图1中三行来写的参数；
        rowNum = ElementNum(ActiveSheet.Cells(j, 2))
        If rowNum > 0 Then
            Call AddRows(j, rowNum)
            Call PasteRows(j, rowNum)
            Call PasteCells(ActiveSheet.Cells(j, 2), j)
        End If
        j = j + rowNum + 1
    Next i
End Sub

 以上代码实现的功能是将下图1自动转换成图2

图1：

图2：

参考文献：

[1]. Excel如何实现两个工作表数据的对比