当前位置：首页 → 问答吧 → 用VBA进行自动编号，越快越好。

用VBA进行自动编号，越快越好。

时间：2011-08-11

来源：互联网

想用VBA实现：每个省市起始编号是1，出现1次，编号加1。我表达得不是很清楚。。。可以看附件。
目标是：能让电脑运行得越快越好。实际工作中有几百个不同城市，几万个数据要编号。。
请高人指点O(∩_∩)O~

附件

地市编号.rar(3.91 KB)

2011-8-11 22:26, 下载次数: 7

作者: llaby 发布时间: 2011-08-11

复制内容到剪贴板

代码:

Sub numberArea()
Dim rng As Range, arr, arrRet() As Long
Dim oDict, i As Long

Set rng = Intersect(Sheet1.UsedRange, Sheet1.Columns(1))
arr = rng
ReDim arrRet(1 To UBound(arr), 1 To 1)
Set oDict = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
      If oDict.exists(arr(i, 1)) Then
         oDict(arr(i, 1)) = oDict(arr(i, 1)) + 1
         arrRet(i, 1) = oDict(arr(i, 1))
      Else
         oDict(arr(i, 1)) = 1
         arrRet(i, 1) = oDict(arr(i, 1))
      End If
Next i
rng.Offset(, 1) = arrRet
End Sub

作者: livewire 发布时间: 2011-08-11

Option Explicit
Sub l()
Dim ar, i%, br()
Dim dic As Object
ar = Sheet1.[a1].CurrentRegion
ReDim br(1 To UBound(ar), 1 To 1)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(ar)
      If Not dic.exists(ar(i, 1)) Then
         dic(ar(i, 1)) = 1
      Else
         dic(ar(i, 1)) = dic(ar(i, 1)) + 1
      End If
      br(i, 1) = dic(ar(i, 1))
Next
[b1].Resize(UBound(ar)).Value = br
End Sub

作者: AVEL 发布时间: 2011-08-11

请测试代码

附件

地市编号.rar(9.21 KB)

2011-8-11 22:46, 下载次数: 4

作者: adong.1111 发布时间: 2011-08-11

Sub Macro1()
Dim d, arr, brr, crr, i, j, m, n, k
arr = Sheet1.Range("a1:a52")
crr = arr
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr, 1)
d(arr(i, 1)) = ""
Next
brr = d.keys
For i = 0 To UBound(brr)
k = 0
For m = 1 To UBound(arr, 1)
If (arr(m, 1)) = brr(i) Then k = k + 1: crr(m, 1) = k
Next
Next
Sheet1.Range("b1").Resize(UBound(crr, 1), 1) = crr
ActiveWindow.SmallScroll Down:=-18
Application.Run "地市编号.xls!Macro1"
ActiveWindow.SmallScroll Down:=-6
Range("B5").Select
ActiveWindow.SmallScroll Down:=-9
End Sub

没仔细考虑，看看可以用不

作者: Qinqinjiang 发布时间: 2011-08-11

4楼函数的办法也挺不错的。

作者: AVEL 发布时间: 2011-08-11

哈哈都有这样多了晕
又学了不少

作者: Qinqinjiang 发布时间: 2011-08-11

简化一下4楼的函数方法。
Sub test()
Range([a1], [a65536].End(3)).Offset(, 1).FormulaR1C1 = "=COUNTIF(R1C1:RC[-1],""=""&RC[-1])"
End Sub

作者: AVEL 发布时间: 2011-08-11

哇哈，看晕了，谢谢各位老师，我仔细一个一个看。

作者: llaby 发布时间: 2011-08-11

Range([a1], [a65536].End(3)).Offset(, 1).FormulaR1C1 ="=SUMPRODUCT(N(RC[-1]=R1C[-1]:RC[-1]))"

作者: livewire 发布时间: 2011-08-11

复制内容到剪贴板

代码:

'凑个热闹
Sub tiansh()
Dim i&, Myr&, Arr
Dim d, k, t
Set d = CreateObject("Scripting.Dictionary")
Myr = Sheet1.[a65536].End(xlUp).Row
Arr = Sheet1.Range("a1:a" & Myr)
k = 0
For i = 1 To UBound(Arr)
d(Arr(i, 1)) = d.Item(Arr(i, 1)) + 1
If d.Exists(Arr(i, 1)) Then Cells(i, 3) = d.Item(Arr(i, 1))
k = d.Item(Arr(i, 1)) + 1
Next
End Sub

作者: wkbu 发布时间: 2011-08-11

用VBA进行自动编号，越快越好。

附件

代码:

附件

代码:

热门阅读

热门下载