请教大神VBA 编程生产表单

ls7264302

在Excel 中如果 单元 L列中L2 =10则执行 复制A2行（第2行整行数据）插入10行相同的数据（现有数据下移）依次往下判断L3=2则执行复制A3行（整行）插入2行依次类推-----？

我的表述不理解的可以找我要数据 我给你介绍。要求就是整理一个表单，写个VBA程式！

谢谢！代码如下：

Dim x As Integer                                                     '定义变量 x 为 整型值

For i = [L65536].End(xlUp).Row To 2 Step -1                          '设定变量范围为i=[L65536的End(方向向上).Row到2步进为-1

    x = Range("L" & i).Value                                          'x=单元格区域("L" & i).Value 取Li列数值

    If IsNumeric(x) Then                                              '如果 IsNumeric(x) 判断X是否是数值 则执行

       For j = 1 To x - 1                                             '设定变量范围为j=1到x-1

          Rows(i).Insert Shift:=xlDown                                '行数(i).Insert变换:=方向向下

       Next                                                           '下一个

       If x <> 1 Then                                                 '如果 x<>1 则执行

          Range("A" & (i + x - 1) & ":BE" & (i + x - 1)).Copy         '单元格区域("A" & (i+x-1) & ":BE" & (i+x-1)).Copy

          Range("A" & i & ":BE" & (i + x - 2)).Select                 '单元格区域("A" & i & ":BE" & (i+x-2)).Select

          ActiveSheet.Paste                                           'ActiveSheet.Paste

          Application.CutCopyMode = False                             'Application.CutCopyMode=False

       End If                                                         

    End If                                                         

Next                                                                 '下一个

现在我需要在这个代码的基础上增加条件如右图1填充表格(AM:AP) 的值

其中AM:AP 的值是 根据K2列值确定的

举例：

• 如果k2=K3=K4=K5则AO2:A06=1,2,3,4，5   AP2=1，2，3，4，5
  
• 依次类推...
  
  

ls7264302

问题前沿在这个地址[http://zhidao.baidu.com/question/329190297654278445.html]，可以具体到表单制作，请教大神编辑 帮忙编写 一个完整的 VBA 程式！

ls7264302

此问题已经解决：

1. Sub Macro1()
   
2. For i = [L65536].End(xlUp).Row To 2 Step -1
   
3. x = Range("L" & i).Value '取L列数值
   
4. If IsNumeric(x) Then '判断数字
   
5. For j = 1 To x - 1
   
6.     Rows(i).Insert Shift:=xlDown
   
7. Next
   
8. If x <> 1 Then
   
9. Range("A" & (i + x - 1) & ":L" & (i + x - 1)).Copy
   
10.       Range("A" & i & ":L" & (i + x - 2)).Select
    
11.       ActiveSheet.Paste
    
12.     Application.CutCopyMode = False
    
13. End If
    
14. End If
    
15. Next

复制代码

大家如果有更好的 可以交流下！