如何根据不同条件循环复制

王西希

各位大神，菜鸟求助~~~~

类型	7月1日	7月2日	7月3日	7月4日	复制次数
A	123	123	234	24	5
B	89	256	345	26	4
C	68	45	33	24	5
D	56	14	35	46	6
E	15	76	134	120	2
F	78	88	156	131	1
G	76	90	98	89	0
H	54	94	100	108	9

如上数据，想要每条数据根据最后一列的复制次数来循环复制；
即：A类型的一条数据复制5次则结果显示5条相同的A 数据
求助怎么写VBA啊

719404338

Sub t()
Dim i%, k%
For i = 10 To 2 Step -1
    For k = 1 To Range("f" & i)
    Rows(i).Select
    Selection.Copy
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next k
Next i
End Sub

719404338

Sub t()
Dim i%, k%
For i = 9 To 2 Step -1
    For k = 1 To Range("f" & i)
    Rows(i).Select
    Selection.Copy
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Next k
Next i
End Sub

719404338

1. Sub t()
   
2. Dim i%, k%
   
3. For i = 9 To 2 Step -1
   
4.     For k = 1 To Range("f" & i)
   
5.     Rows(i).Select
   
6.     Selection.Copy
   
7.     Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
   
8.      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
   
9.         :=False, Transpose:=False
   
10.     Next k
    
11. Next i
    
12. End Sub
    

复制代码

liulang0808

建议楼主上传模拟附件，便于解答

jiminyanyan

0的不要复制？。。。。

王西希

jiminyanyan 发表于 2018-7-28 21:29
0的不要复制？。。。。

0不用复制的

王西希

719404338 发表于 2018-7-28 21:03

解决了，谢谢~

kuangben8

Sub 复制()
    Dim arr, i%, brr(), k%, m%, n%, j%
    Sheet2.Cells.ClearContents
    arr = Sheet1.Range("A1").CurrentRegion
    For i = 2 To UBound(arr, 1)
        k = k + arr(i, 6)
    Next
    ReDim brr(1 To k + UBound(arr, 1), 1 To 5)
    brr(1, 1) = arr(1, 1)
    brr(1, 2) = arr(1, 2)
    brr(1, 3) = arr(1, 3)
    brr(1, 4) = arr(1, 4)
    brr(1, 5) = arr(1, 5)
    j = 0
    For m = 2 To UBound(arr, 1)
        For n = 1 To arr(m, 6) + 1
            brr(j + n + 1, 1) = arr(m, 1)
            brr(j + n + 1, 2) = arr(m, 2)
            brr(j + n + 1, 3) = arr(m, 3)
            brr(j + n + 1, 4) = arr(m, 4)
            brr(j + n + 1, 5) = arr(m, 5)
        Next
        j = j + n - 1
    Next
    Sheet2.Range("A1").Resize(k + UBound(arr, 1), 5) = brr
End Sub

kuangben8

记录复制20180729.zip (18.39 KB, 下载次数: 28)

2018-7-29 23:27 上传

点击文件名下载附件