|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub test()
- Dim data, i&, dic, d, r
- data = ThisWorkbook.Worksheets("Sheet1").[A1].CurrentRegion.Value
- Set dic = CreateObject("Scripting.Dictionary")
- For i = 2 To UBound(data)
- If data(i, 3) <> "" Then
- dic(data(i, 3)) = dic(data(i, 3)) + 1
- End If
- Next i
- For i = 2 To UBound(data)
- r = 1
- For Each d In dic.keys
- If d > data(i, 3) Then r = dic(d) + r
- Next d
- data(i, 4) = r
- Next i
- ThisWorkbook.Worksheets("Sheet1").[A1].Resize(UBound(data), UBound(data, 2)) = data
- End Sub
复制代码 |
|