[已解决]求一个自动生成序号的VBA

c5h8o4nna

aaa	1
aaa	2
aaa	3
bbb	1
bbb	2
bbb	3
ccc	1
ddd	1
ddd	2
ddd	3

想找一个简单的VBA自动生成序号，可以做到吗？最好能够在指定的列里执行{:021:}
因为要处理的数量很大，一页里6万多条，用公式生成电脑实在受不了

最佳答案

月排行榜 / 总排行榜

爱疯

2015-12-15 09:22

Sub Click()
    Dim A, d, i
    Range("b:b").ClearContents
    A = Range([a1], Cells(Rows.Count, 1).End(3))
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(A)
        d(A(i, 1)) = d(A(i, 1)) + 1
        A(i, 1) = d(A(i, 1))
    Next i
    [b1].Resize(UBound(A)) = A
End Sub
1.rar (15.29 KB, 下载次数: 23)

2015-12-15 09:22 上传

点击文件名下载附件


如果A列不重复项的个数不超过65536，可以这样。

跳转到最佳答案楼层

爬山虎

生成的序号有什么要求？

爱疯

Sub Click()
    Dim A, d, i
    Range("b:b").ClearContents
    A = Range([a1], Cells(Rows.Count, 1).End(3))
    Set d = CreateObject("scripting.dictionary")
    For i = 1 To UBound(A)
        d(A(i, 1)) = d(A(i, 1)) + 1
        A(i, 1) = d(A(i, 1))
    Next i
    [b1].Resize(UBound(A)) = A
End Sub
1.rar (15.29 KB, 下载次数: 23)

2015-12-15 09:22 上传

点击文件名下载附件


如果A列不重复项的个数不超过65536，可以这样。

c5h8o4nna

爱疯 发表于 2015-12-15 09:22
Sub Click()
    Dim A, d, i
    Range("b:b").ClearContents

能不能在指定列生成呢？

爱疯

c5h8o4nna 发表于 2015-12-15 18:52
能不能在指定列生成呢？

比如，输出在F列，下句改下就行了

[f1].Resize(UBound(A)) = A

c5h8o4nna

爱疯 发表于 2015-12-15 19:02
比如，输出在F列，下句改下就行了

[f1].Resize(UBound(A)) = A

原来如此

那又如果需要排序的列不是A，而是B列或其它列，那又怎么做呢？
A = Range([a1], Cells(Rows.Count, 1).End(3))
a1改为b1吗？

爱疯

比如，数据在P和Q两列，就改成

A = Range([p1], Cells(Rows.Count, "q").End(3))

c5h8o4nna

爱疯 发表于 2015-12-15 19:31
比如，数据在P和Q两列，就改成

A = Range([p1], Cells(Rows.Count, "q").End(3))

如果在B列， A = Range([b1], Cells(Rows.Count, 1).End(3))
对吗

爱疯

c5h8o4nna 发表于 2015-12-15 19:46
如果在B列， A = Range([b1], Cells(Rows.Count, 1).End(3))
对吗

数据源在b列，就把7楼有颜色的两个字符都改成b。

c5h8o4nna

爱疯 发表于 2015-12-15 19:51
数据源在b列，就把7楼有颜色的两个字符都改成b。

用了你那个VBA不行哦，我的源在B列，结果把B列的数据全部删了