測試數據表：
程序代碼圖：
執行效果：
程序文本：
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