EXCEL数组公式清除速度太慢

20万行！想想就叫人崩溃，试试下面的自定义函数：

Function funa(r As Range) As Integer
    a = r
    n = UBound(a, 2)
    For i = 1 To n
        If a(1, i) = "" Then
            c = c + 1
        Else
            If c > d Then d = c
            c = 0
        End If
    Next
    If c > d Then
        funa = c
    Else
        funa = d
    End If
End Function
Function funb(r As Range) As Integer
    a = r
    n = UBound(a, 2)
    For i = 1 To n
        If a(1, i) = "" Then
            c = c + 1
        Else
            Exit For
        End If
    Next
    funb = c
End Function

=FUNA(V2:BFI2)

=FUNB(V2:BFI2)

往下填充

暂时没想到更好的方法
你可以去Excelhome找高手问问看
下面这个程序，能够实现你的要求，但是运行速度有些慢
我试了10万行，需要半个小时。。。。

Sub m()
Application.DisplayAlerts = False

k = InputBox("请输入运行最大行数")
fname = ActiveSheet.Name
Sheets.Add
ActiveSheet.Name = "linshi"
Sheets(fname).Activate
For i = 2 To k
For j = 22 To 1517
If Cells(i, j) = "" Then
x = x + 1
Else
y = y + 1
Sheets("linshi").Cells(i, y) = x
x = 0
End If
Next j
x = 0
y = 0
Cells(i, "H") = Application.Max(Sheets("linshi").Range("A" & i & ":BFI" & i))
Cells(i, "I") = Sheets("linshi").Cells(i, 1)

Next i
Sheets("linshi").Delete
Application.DisplayAlerts = True
End Sub