level 3
用COUNTIF函数，1排有一个，他就显示数量1,1排有3个，他还是显示数量1
2023年03月13日 14点03分
level 11
Option ExplicitSub abc()
Dim a(2), i, j, t, sum
For i = 1 To 2
a(i) = Cells(1, i).Resize(Cells(1, i).End(xlDown).Row).Value
Next
For i = 1 To UBound(a(2))
For j = 1 To UBound(a(1))
t = a(1)(j, 1)
t = Replace(t, a(2)(i, 1), vbNullString)
sum = sum + (Len(a(1)(j, 1)) - Len(t)) / Len(a(2)(i, 1))
Next
a(2)(i, 1) = sum: sum = 0
Next
[c1].Resize(UBound(a(2))) = a(2)
End Sub
感谢
2023年03月15日 10点03分
level 11
Option Explicit
Sub abc()
Dim a(2), i, j, t, sum
For i = 1 To 2
a(i) = Cells(1, i).Resize(Cells(1, i).End(xlDown).Row).Value
Next
For i = 1 To UBound(a(2))
For j = 1 To UBound(a(1))
t = a(1)(j, 1)
t = Replace(t, a(2)(i, 1), vbNullString)
sum = sum + (Len(a(1)(j, 1)) - Len(t)) / Len(a(2)(i, 1))
Next
a(2)(i, 1) = sum: sum = 0
Next
[c1].Resize(UBound(a(2))) = a(2)
End Sub
2023年03月14日 01点03分
5
Sub abc()
Dim a(2), i, j, t, sum
For i = 1 To 2
a(i) = Cells(1, i).Resize(Cells(1, i).End(xlDown).Row).Value
Next
For i = 1 To UBound(a(2))
For j = 1 To UBound(a(1))
t = a(1)(j, 1)
t = Replace(t, a(2)(i, 1), vbNullString)
sum = sum + (Len(a(1)(j, 1)) - Len(t)) / Len(a(2)(i, 1))
Next
a(2)(i, 1) = sum: sum = 0
Next
[c1].Resize(UBound(a(2))) = a(2)
End Sub
level 11
'这个估计要精确匹配Option Explicit
Sub abc()
Dim a(2), i, j, k, t, sum
For i = 1 To 2
a(i) = Cells(1, i).Resize(Cells(1, i).End(xlDown).Row).Value
Next
For i = 1 To UBound(a(2))
For j = 1 To UBound(a(1))
t = Split(a(1)(j, 1), "，") '大逗号
For k = 0 To UBound(t)
If a(2)(i, 1) = t(k) Then sum = sum + 1
Next
Next
a(2)(i, 1) = sum: sum = 0
Next
[c1].Resize(UBound(a(2))) = a(2)
End Sub
