隔n行重排一列，异表输出。求助老师。

cjb3030

如附件，拜托各位老师了。

山菊花

供参考。

cjb3030

山菊花 发表于 2018-6-30 14:24
供参考。

谢谢版主，谢谢。非常完美。

活在理想的世界

在Sheet1里面粘贴此代码

Private Sub Worksheet_Change(ByVal Target As Range)
Dim arr(), brr()
ReDim brr(1 To 20, 1 To 5): k = Sheet1.[a7]
If Target.Address(False, False) = "A7" Then
    For i = 1 To 100 Step k
       For j = 1 To k
            s = s + 1: ReDim Preserve arr(1 To s): arr(s) = Sheet2.Range("a" & (i + k) Mod 100).Offset(j - 1, 0)
       Next
    Next
    For c = 1 To 5
        For r = 1 To 20
            l = l + 1: brr(r, c) = arr(l)
        Next
    Next
    Sheet3.Range("c1").Resize(20, 5) = brr
    Sheet3.Select
End If
End Sub

cjb3030

活在理想的世界 发表于 2018-6-30 15:14
在Sheet1里面粘贴此代码

Private Sub Worksheet_Change(ByVal Target As Range)

您的代码只有整数除尽的隔行数才能正确显示，所以有点不足。谢谢出手。