[已解决]求助一个快速摄取的代码

ryoryo66

C9:G列数值是根据"开奖数据"A9:E列开始,到A列最后的非空单元格为止.
表"断断"的C9:G列是和"开奖数据"A9:E是完全一样的引用过来.
表"1"的C9:G列的最后一行是"开奖数据"A列最后非空开始,往上隔1行的数据引用过来的
表"2"的C9:G列的最后一行是"开奖数据"A列最后非空开始,往上隔2行的数据引用过来的
表"3"的C9:G列的最后一行是"开奖数据"A列最后非空开始,往上隔3行的数据引用过来的
.....
表"20"的C9:G列的最后一行是"开奖数据"A列最后非空开始,往上隔20行的数据引用过来的

以前用的是 设置的名称然后用VLOOKUP引用的.增加行数又大又麻烦.

大师看看这个能不能用数组或字典这种快速的办法返回?

最佳答案

月排行榜 / 总排行榜

shuidisyy

2021-3-25 19:27

Sub test()
    Dim arrData, arrResult, arrTable, rng As Range
    Dim irow%, i%, j%, k%, n%, r%, max%
    With Sheet1
        Set rng = .Range("a:a").Find("*", , xlValues, , , xlPrevious)
        If Not rng Is Nothing Then irow = rng.Row
        If irow < 9 Then Exit Sub
        arrData = .Range("a9:e" & irow).Value
    End With
    max = UBound(arrData)
    Sheets("断断").Range("c9").Resize(max, UBound(arrData, 2)) = arrData
    For k = 1 To 3
        n = max \ (k + 1)
        If max Mod (k + 1) > 0 Then n = n + 1
        ReDim arrResult(1 To n, 1 To UBound(arrData, 2))
        For i = max To 1 Step -(k + 1)
            For j = 1 To UBound(arrData, 2)
                arrResult(n, j) = arrData(i, j)
            Next j
            n = n - 1
        Next i
        With Sheets(CStr(k))
             Range("c9:e" & Rows.Count).ClearContents
            .Range("c9").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
        End With
    Next k
End Sub

跳转到最佳答案楼层

shuidisyy

Sub test()
    Dim arrData, arrResult, arrTable, rng As Range
    Dim irow%, i%, j%, k%, n%, r%, max%
    With Sheet1
        Set rng = .Range("a:a").Find("*", , xlValues, , , xlPrevious)
        If Not rng Is Nothing Then irow = rng.Row
        If irow < 9 Then Exit Sub
        arrData = .Range("a9:e" & irow).Value
    End With
    max = UBound(arrData)
    Sheets("断断").Range("c9").Resize(max, UBound(arrData, 2)) = arrData
    For k = 1 To 3
        n = max \ (k + 1)
        If max Mod (k + 1) > 0 Then n = n + 1
        ReDim arrResult(1 To n, 1 To UBound(arrData, 2))
        For i = max To 1 Step -(k + 1)
            For j = 1 To UBound(arrData, 2)
                arrResult(n, j) = arrData(i, j)
            Next j
            n = n - 1
        Next i
        With Sheets(CStr(k))
             Range("c9:e" & Rows.Count).ClearContents
            .Range("c9").Resize(UBound(arrResult), UBound(arrResult, 2)) = arrResult
        End With
    Next k
End Sub

ryoryo66

shuidisyy 发表于 2021-3-29 20:40
Sub test()
    Dim arrData, arrResult, arrTable, rng As Range
    Dim irow%, i%, j%, k%, n%, r%, m ...

非常感谢大师.

这个,断断先返回,然后下面清空C9:E,这样断断的也清空了.
我在Sheets("断断").Range("c9").Resize(max, UBound(arrData, 2)) = arrData这句上面加一个清空.
然后在
With Sheets(CStr(k))
             Range("c9:e" & Rows.Count).ClearContents  这句前面加个点.
这样不会影响速度吧.

shuidisyy

不会，我把点给漏了

ryoryo66

shuidisyy 发表于 2021-3-30 18:57
不会，我把点给漏了

再次感谢老师!