Excel VBA：快速計算兩個1中間0的個數

昨天處理一個網友的問題，需要對每個Column計算兩個1之間含有多少個0，而Column是由0、1組成，他是一個不會寫程式的使用者，所以連怎麼問問題與表達需求都是問題，加上他一開始提供的資料就有問題，後續請他調整後才能看出了解實際需求，聽他表達需求就要花上半天時間才能理解，最後請他改以影片列出，程式開發花不到5分鐘，以下就簡單用個簡單亂數範例做介紹。
以亂數產生300個1、0。

很多人面對要計算兩個1中間0的個數，就想以for 迴圈 + if 判斷去處理，這樣執行效率是最差，這我在書本提過，可以參考「Excel VBA 實戰技巧｜金融數據x網路爬蟲」基礎篇 「05 Excel VBA 程式碼優化」，如果一遇到幾百萬筆資料，那豈不跑上半天到一天，所以寫程式要多做考量才行，不是一股腦就卯起來寫，自己寫的爽，執行卻效率很差，這樣的作法是很不適當。

程式碼如下：

Const column As String = "A,B,C,D,E"

Sub 執行()
    Sheets(1).Cells.Clear
    範例1由亂數產生器 300
    計算兩個1中間0的個數
End Sub

Sub 範例1由亂數產生器(n As Integer)
    Dim i As Integer, col
    Randomize '初始化亂數產生器
    For Each col In Split(column, ",")
        For i = 1 To n
            Sheets(1).Cells(i, col) = (Int(Rnd() * 100) + 1) Mod 2
        Next
    Next
End Sub

Sub 範例2由亂數產生器與陣列公式(n As Integer)
    Dim col
    For Each col In Split(column, ",")
        Sheets(1).Cells(1, col).Resize(n).FormulaArray = "=MOD(INT(RAND()*100)+1,2)"
    Next
End Sub

Sub 計算兩個1中間0的個數()
    Dim row As Integer, num As Integer, pos As Integer, i As Integer, tmp, col
    For Each col In Split(column, ",")
        row = Sheets(1).Cells(65536, col).End(xlUp).row
        tmp = Application.Transpose(Sheets(1).Cells(1, col).Resize(row)): tmp = Join(tmp, "")
        pos = InStr(tmp, "1"): If pos <> 1 Then tmp = Mid(tmp, pos, Len(tmp))
        tmp = Split(tmp, "1"): ReDim arr(0)
        For i = 0 To UBound(tmp)
            If i = 0 Then
                arr(0) = Len(tmp(i))
            Else
                ReDim Preserve arr(UBound(arr) + 1)
                arr(UBound(arr)) = Len(tmp(i))
            End If
        Next
        Debug.Print col + " : " + Join(arr, "-") + vbCrLf
        Erase arr
    Next
End Sub

程式碼邏輯很簡單，既然是1跟0組成，那就將這些數字組成字串，再以字串分割1出來，最後將每個分割出來的字串取其長度即可完成。

執行結果