當前位置:成語大全網 - 新華字典 - EXCEL VBA統計的代碼?

EXCEL VBA統計的代碼?

測試數據表:

程序代碼圖:

執行效果:

程序文本:

Option Explicit

Sub 宏1()

Dim a(), d(1 To 9) As Object, e(), h(), i&, j&, n&, st As Worksheet

For Each st In Sheets '對所有工作表

If st.Name <> "開獎數據" Then

'切換表,並獲取內容到數組中

st.Activate

'參數區處理:建立字典,1-9表示H-P的列號

a = st.Range("h1:p1")

For i = 1 To UBound(a, 2)

If Not d(i) Is Nothing Then

d(i).RemoveAll

Else

Set d(i) = CreateObject("Scripting.Dictionary")

End If

a(1, i) = Trim(a(1, i))

For j = 1 To Len(a(1, i))

d(i)(Mid(a(1, i), j, 1)) = 1

Next j

Next i

'數據區處理

n = st.Cells(st.Rows.Count, "e").End(xlUp).Row 'E列最後壹行行號

If n >= 9 Then '跳過不足9行的表

e = st.Range(st.Cells(9, "e"), st.Cells(n, "g")) 'E:G - 源數組

h = st.Range(st.Cells(9, "h"), st.Cells(n, "p")) 'H:P - 結果數組

For i = 1 To UBound(e)

For j = 1 To 3

e(i, j) = Trim(e(i, j))

Next j

If e(i, 1) <> "" And e(i, 2) <> "" And e(i, 3) <> "" Then

For j = 1 To UBound(a, 2)

If d(j)(e(i, 1)) + d(j)(e(i, 2)) + d(j)(e(i, 3)) >= 2 Then

h(i, j) = 2

Else

h(i, j) = Empty

End If

Next j

End If

Next i

'數組回寫表

With st.Range(st.Cells(9, "h"), st.Cells(n, "p"))

.Select

.Value = h

End With

End If

End If

Next st

End Sub