|
Sub test11()
Set sh1 = Sheets("sheet1")
r = sh1.[a65536].End(3).Row 'a列有数据的最大行号
sh1.Range("i4:k" & sh1.[i65536].End(3).Row).Copy: sh1.Cells(r + 1, 3).PasteSpecial Paste:=xlPasteValues
Set d = CreateObject("Scripting.Dictionary") '定义字典对象
r = sh1.[a65536].End(3).Row 'a列有数据的最大行号
arr = sh1.Range("a1:e" & r) '给数组arr赋值
For i = 2 To UBound(arr) '相当于行循环
If arr(i, 1) <> "" Then s = arr(i, 3)
d(s) = Left(arr(i, 1), InStr(arr(i, 1), "-"))
Next i
Im = d.items
brr = sh1.[a1].CurrentRegion
For Each rg In d.keys
For j = 2 To UBound(brr)
If brr(j, 3) = rg Then
n = n + 1
brr(j, 1) = d(rg) & n
brr(j, 2) = n
End If
Next j
n = 0
Next rg
sh1.[a1:e60000].ClearContents
sh1.[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub
|
评分
-
1
查看全部评分
-
|