[已解决]求助一个快速统计的代码.

ryoryo66

最大连出的代码
最大连出:返回第7行.
就是从第9行 至 E列不为空的最后一行;比如:H9:H6825,这个范围内,出现连续不为空的值(值的范围是0-9个位数),连续最多的就返回出来.

有另一个情况,就是比如:H9:H834,如果H834的上面直到H834出现连续不为空的值已经超过了其它的最多连续的值,那么就依旧显示其它的最多连续的值(如13). 就像H列,直到H834行连续出现了17次,那么除此之外最多只连续出现了13次,那么依旧显示13次,直到有空值出现.

这个代码用快速的数组啊,字典之类方法怎么写啊?还有一次填入"断断,1-100"这101个表格中的H:K列.(因为太大,所以这里就显示出了(断断和1,2这三个表).
请老师帮忙看看.因为公式太慢了,所以想用VBA.

最佳答案

月排行榜 / 总排行榜

shuidisyy

2021-3-17 16:52

Sub test()
    Dim arr, brr(), arrTable(), i%, j%, n%, max%, irow%, k%, rng As Range
    ReDim arrTable(0 To 2)
    For i = 1 To UBound(arrTable)
        arrTable(i) = CStr(i)
    Next i
    arrTable(0) = "断断"
    For k = 0 To UBound(arrTable)
        With Worksheets(arrTable(k))
            Set rng = .Range("e:e").Find("*", , xlValues, , , xlPrevious)
            If Not rng Is Nothing Then irow = rng.Row
            If irow < 9 Then GoTo noData
            arr = .Range("h9:k" & irow).Value
            ReDim brr(1 To 2, 1 To UBound(arr, 2))
            For j = 1 To UBound(arr, 2)
                max = 0
                n = 0
                For i = 1 To UBound(arr)
                    If Len(arr(i, j)) Then
                        n = n + 1
                    Else
                        If n > max Then max = n
                        n = 0
                    End If
                Next i
                brr(1, j) = max
                brr(2, j) = n
            Next j
            .Range("h7").Resize(2, UBound(brr, 2)) = brr
        End With
noData:
    Next k
End Sub

跳转到最佳答案楼层

shuidisyy

Sub test()
    Dim arr, brr(), arrTable(), i%, j%, n%, max%, irow%, k%, rng As Range
    ReDim arrTable(0 To 2)
    For i = 1 To UBound(arrTable)
        arrTable(i) = CStr(i)
    Next i
    arrTable(0) = "断断"
    For k = 0 To UBound(arrTable)
        With Worksheets(arrTable(k))
            Set rng = .Range("e:e").Find("*", , xlValues, , , xlPrevious)
            If Not rng Is Nothing Then irow = rng.Row
            If irow < 9 Then GoTo noData
            arr = .Range("h9:k" & irow).Value
            ReDim brr(1 To 2, 1 To UBound(arr, 2))
            For j = 1 To UBound(arr, 2)
                max = 0
                n = 0
                For i = 1 To UBound(arr)
                    If Len(arr(i, j)) Then
                        n = n + 1
                    Else
                        If n > max Then max = n
                        n = 0
                    End If
                Next i
                brr(1, j) = max
                brr(2, j) = n
            Next j
            .Range("h7").Resize(2, UBound(brr, 2)) = brr
        End With
noData:
    Next k
End Sub

ryoryo66

shuidisyy 发表于 2021-3-17 16:52
Sub test()
    Dim arr, brr(), arrTable(), i%, j%, n%, max%, irow%, k%, rng As Range
    ReDim arr ...

辛苦老师了,真强大!

ryoryo66

shuidisyy 发表于 2021-3-17 16:52
Sub test()
    Dim arr, brr(), arrTable(), i%, j%, n%, max%, irow%, k%, rng As Range
    ReDim arr ...

老师,如果我想反过来,统计一下 区域内 空的 单元格 的最大连出和当前连出,这个需要怎么修改一下?

shuidisyy

ryoryo66 发表于 2021-3-18 16:49
老师,如果我想反过来,统计一下 区域内 空的 单元格 的最大连出和当前连出,这个需要怎么修改一下?

Len(arr(i, j))=0

ryoryo66

shuidisyy 发表于 2021-3-18 18:29
Len(arr(i, j))=0

非常感谢老师..辛苦了!

ryoryo66

shuidisyy 发表于 2021-3-18 18:29
Len(arr(i, j))=0

老师,再问一下,如果区域内的中间有一列是空的,我不想在这一列的第7行返回数组,有没有办法不返回这一格?

ryoryo66

shuidisyy 发表于 2021-3-18 18:29
Len(arr(i, j))=0

比如I:J两列是空的,这样的话,就只返回H和K列的,这样能不能修改?
我用判断行不通

shuidisyy

ryoryo66 发表于 2021-3-18 23:17
比如I:J两列是空的,这样的话,就只返回H和K列的,这样能不能修改?
我用判断行不通

判断一下，如果都为0，就不写入了
if max<>0 or n <>0 then
    brr(1, j) = max    brr(2, j) = n

end if

ryoryo66

shuidisyy 发表于 2021-3-21 22:52
判断一下，如果都为0，就不写入了
if max0 or n 0 then
    brr(1, j) = max    brr(2, j) = n

非常感谢老师.
老师有空的时候能不能再帮我看一下这个问题.
http://www.excelpx.com/forum.php ... &extra=page%3D1