A列每个单元格复制N遍，每几个单元格插入N个空白格

清风竹-

niko88819 发表于 2023-5-1 06:43
清风竹-老师可以贴出分享代码吗?下载打开代码都遗失

进入工程资源管理器，右击窗体，查看代码。

清风竹-

niko88819 发表于 2023-5-1 06:43
清风竹-老师可以贴出分享代码吗?下载打开代码都遗失

进入工程资源管理器，右击窗体，查看代码。

准提部林

Sub TEST_A1()
Dim Arr, Brr, i&, j%, Jn%, R%, Rn%, Xn%, N&
Jn = ActiveSheet.TextBoxes("TextBox 4").Text + 1
Rn = ActiveSheet.TextBoxes("TextBox 5").Text + 1
Xn = ActiveSheet.TextBoxes("TextBox 3").Text
Arr = Range([a1], [a65536].End(3)(2))
ReDim Brr(1 To UBound(Arr) * Jn + UBound(Arr) / (Rn + (Rn > 1)) * (Xn + 1), 0)
For i = 1 To UBound(Arr)
    For j = 1 To Jn - 1
        N = N + 1: Brr(N, 0) = Arr(i, 1)
    Next j
    R = R + 1
    If R = Rn - 1 Then N = N + Xn: R = 0
Next i
[c:c].ClearContents
[c1].Resize(N) = Brr
End Sub

niko88819

清风竹- 发表于 2023-5-1 09:42
进入工程资源管理器，右击窗体，查看代码。

老师,代码都遗失了,都成空白,因为代码含有简或是繁体字,打开EXCEL就自动不见了

清风竹-

niko88819 发表于 2023-5-1 06:43
清风竹-老师可以贴出分享代码吗?下载打开代码都遗失

请参考图片。

niko88819

感谢清风竹-老师!!!