搞一上午搞不出来，求问大神帮忙，拜谢！

GZ00

A列的水果在D列循环填写，循环填写次数为B列的数字，有空行的空着就行，求解大神如何实现

wtg321

1. Sub ww()
   
2. m = 1
   
3. For i = 1 To [b65536].End(3).Row
   
4. For j = 1 To IIf(Cells(i, 2) = "", 1, Cells(i, 2))
   
5. Cells(m, 4) = Cells(i, 1)
   
6. m = m + 1
   
7. Next
   
8. Next
   
9. End Sub

复制代码

dragonthree

没代码？我以为要修改呢！

dragonthree

1. Sub kj()
   
2. Dim arr, brr
   
3. Application.ScreenUpdating = False
   
4. Set Sh1 = ActiveSheet
   
5. With Sh1
   
6.   arr = .Range("a1:b" & .Cells(.Rows.Count, 1).End(3).Row)
   
7. End With
   
8. ReDim brr(1 To 100000, 1 To 1)
   
9. For i = 1 To UBound(arr)
   
10.    If arr(i, 1) <> "" Then
    
11.       For j = 1 To arr(i, 2)
    
12.         m = m + 1
    
13.         brr(m, 1) = arr(i, 1)
    
14.       Next
    
15.   Else
    
16.       m = m + 1
    
17.       brr(m, 1) = arr(i, 1)
    
18.   End If
    
19. Next
    
20. With Sh1
    
21.      .Range("d1:d" & .Rows.Count).ClearContents
    
22.      .Range("d1").Resize(m, 1) = brr
    
23. End With
    
24. Application.ScreenUpdating = True
    
25. MsgBox "OK!"
    
26. End Sub

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.6.14
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     arr = [a1].Resize(r, 2)
   
4.     ReDim brr(1 To 10000, 1 To 1)
   
5.     For i = 1 To UBound(arr)
   
6.         If arr(i, 1) = Empty Then m = m + 1
   
7.         For x = 1 To arr(i, 2)
   
8.             m = m + 1
   
9.             brr(m, 1) = arr(i, 1)
   
10.         Next
    
11.     Next
    
12.     [d:d] = ""
    
13.     [d1].Resize(m, 1) = brr
    
14.     MsgBox "OK！"
    
15. End Sub
    

复制代码

pkkkkkkkkp

wtg321 发表于 2024-6-14 11:22

1. `Sub ww()`：定义了一个名为 `ww` 的子程序。
2. `m = 1`：初始化变量 `m` 为1，`m`用于跟踪D列的行号。
3. `For i = 1 To [b65536].End(3).Row`：从第1行开始循环，直到B列中最后一个非空单元格的行号。`[b65536].End(3).Row` 查找B列中最后一个非空单元格的行号。
4. `For j = 1 To IIf(Cells(i, 2) = "", 1, Cells(i, 2))`：嵌套循环，次数由B列中的值决定。如果B列为空，则循环一次。
5. `Cells(m, 4) = Cells(i, 1)`：将A列中的当前单元格的值复制到D列中的第 `m` 行。
6. `m = m + 1`：增加 `m` 的值，以便在下一次循环时写入D列的下一行。
7. `Next j`：结束内部循环。
8. `Next i`：结束外部循环。
9. `End Sub`：结束子程序。
总体来说，这段代码将A列中的值根据B列中的值扩展并复制到D列。

LIUZHU

参与下，效果

LIUZHU

JS代码

1. function 复制(){
   
2.         let arr=Sheets.Item("Sheet1").Range("a1:b9").Value2.reduce((arr,[a,b])=>{
   
3.                 return arr.push(...Array(b || 1).fill([a])), arr;
   
4.         },[])
   
5.         Range("d1").Resize(arr.length,1).Value2=arr;
   
6. }

复制代码

LIUZHU

附件，WPS测试有效