EXCEL根据某一单元格的值，自动复制插入行。求详细VBA代码?十分感谢

Question

EXCEL根据某一单元格的值，自动复制插入行。再表上颜色颜色，求详细VBA代码，图一是没改过的，图二是改好的效果图,
根据内件名称那一列来复制插入，里面有几个物品就复制几行，
图1

图2是需要的结果，

Answer 1

1、添加内件名称数据辅助列，输入以下公式，然后向下填充公式

=LEN(N2)-LEN(SUBSTITUTE(N2,",",""))+1

2、添加行数对应辅助列，输入以下公式，然后向下填充公式

=SUM(Q$2:Q2)-Q2

3、输入以下公式，然后向右向下填充公式

=IF(ROW(A1)-1<SUM($Q:$Q),LOOKUP(ROW(A1)-1,$R$2:$R$4,B$2:B$4),"")

生成对应内件名称个数的行数内容。

 

详见附图同表举例

追问

能帮忙自己上颜色吗 方便区分
因为数据量太大了，一个个上颜色太慢了

Answer 2

Sub fuzhi()
with activesheet
 For i = .Range("N65536").End(xlUp).Row To 2 Step -1
     n = UBound(Split(.Cells(i, "N"), ","))
     .Rows(i & ":" & i + n - 1).Insert
     .Rows(i + n).Copy .Rows(i & ":" & i + n - 1)
     .Rows(i + 1 & ":" & i + n).Interior.Color = vbGreen
 Next
 end with
End Sub

追问

这个太棒了！能不能把复制的原数据行也上颜色

追答

上什么颜色， 颜色必须要不一样吧， 一样 就没意义了

Sub fuzhi()
With ActiveSheet
 For i = .Range("N65536").End(xlUp).Row To 2 Step -1
     n = UBound(Split(.Cells(i, "N"), ","))
     .Rows(i & ":" & i + n - 1).Insert
     .Rows(i + n).Copy .Rows(i & ":" & i + n - 1)
     .Rows(i + 1 & ":" & i + n).Interior.Color = vbGreen
     .Rows(i).Interior.Color = vbYellow
 Next
 End With
End Sub

追问

是这样的 我的数据有的是内件名称有多个的时候才需要复制，如果里面是单个的名称就不需要复制也不需要颜色，所以需要跟复制的原数据行颜色一样。便于区分.这是我们实际排列效果.

追答

你是说 单个名称不 需要处理是么

只需要告诉 我要做什么就好了，不需要写这么多

代码如下

Sub fuzhi()
With ActiveSheet
 For i = .Range("N65536").End(xlUp).Row To 2 Step -1
     n = UBound(Split(.Cells(i, "N"), ","))
    If n > 0 Then
     .Rows(i & ":" & i + n - 1).Insert
     .Rows(i + n).Copy .Rows(i & ":" & i + n - 1)
     .Rows(i & ":" & i + n).Interior.Color = vbGreen
    End If
 Next
 End With
End Sub

追问

可以了，成功了 谢谢您朋友，