|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub qs()
- Dim arr, brr, i, dic
- Set dic = CreateObject("scripting.dictionary")
- With Sheet1
- rw = .Cells(Rows.Count, "k").End(3).Row
- arr = .Range("b2:k" & rw).Value
- brr = .Range("m2:r" & rw).Value
- For Each a In arr
- If Not IsNumeric(a) Then
- If Not dic.exists(a) Then
- dic(a) = 1
- Else
- dic(a) = dic(a) + 1
- End If
- End If
- Next
- For i = 1 To UBound(brr)
- For j = 1 To 6 Step 2
- brr(i, j + 1) = dic(brr(i, j))
- Next
- Next
- .Range("m2").Resize(UBound(brr), UBound(brr, 2)) = brr
- End With
- Set dic = Nothing
- End Sub
复制代码 |
|