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

Public Function AddRows(pos As Integer, amount As Integer)
    Dim rpos As Integer
    rpos = pos +
    For i =  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 +
    rEndPos = startPos + amount

    Rows(startPos & ":" & startPos).Select
    Selection.Copy
    Rows(startPos +  & ":" & 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 =
    a = Split(str, ",")
    num = UBound(a) - LBound(a) + pos
    For i = pos To num
        ActiveSheet.Cells(i, ) = a(j)
        j = j +
    Next i
End Function

Sub BomSplit()
    Dim rowNum As Integer
    Dim i As Integer
    Dim j As Integer

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

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

图1：

图2：

参考文献：

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