Sub TEST()
Dim A, xD, Arr, Brr, j&, Jm&, k%
Set xD = CreateObject("Scripting.Dictionary")
Arr = [¤u§@ªí2!A3:N3]
ReDim Brr(1 To 2, 1 To UBound(Arr, 2))
For Each A In Range([¤u§@ªí1!c2], [¤u§@ªí1!c1].Cells(Rows.Count, 1).End(xlUp)).Value
¡@¡@If A = "" Or xD(A) = 1 Then GoTo 101
¡@¡@Jm = 1
¡@¡@For j = 3 To UBound(Arr, 2) Step 2
¡@¡@¡@¡@If InStr(A, Arr(1, j)) Then Jm = j: Exit For
¡@¡@Next j
¡@¡@If InStr(A, "V") Then k = 2 Else k = 1
¡@¡@Brr(k, Jm) = Brr(k, Jm) + 1
¡@¡@xD(A) = 1
101: Next
[¤u§@ªí2!A5:N6] = Brr
End Sub
¨º¬O²Öp¤£«ÂÐÓ¼Æ!
¨S¸ê®ÆÅã¥Ü1? ¤°»ò·N«ä?§ï¦¨¥H¤U:Åý¸ê®Æ½d³ò¦h¥[¤G¦CªÅ¥Õ¦C
For Each A In Range([¤u§@ªí1!c2], [¤u§@ªí1!c1].Cells(Rows.Count, 1).End(xlUp)(3)).Value