按月份重新编号

yunfei2018

  如下图所示，A列的序号根据B列的月份重新编号，用VBA代码该如何表示，求解，谢谢！

  

lsc900707

建议楼主同步上传附件。

yunfei2018

lsc900707 发表于 2018-9-27 17:07
建议楼主同步上传附件。

抱歉，补上测试附件，

                                 按部门编号.zip (7.01 KB, 下载次数: 8)

2018-9-27 17:12 上传

点击文件名下载附件

lsc900707

yunfei2018 发表于 2018-9-27 17:12
抱歉，补上测试附件，

1. Sub gj23w98()
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     ar = [a3].CurrentRegion
   
4.     For i = 2 To UBound(ar)
   
5.         If d.exists(ar(i, 2)) Then
   
6.             d(ar(i, 2)) = d(ar(i, 2)) + 1
   
7.         Else
   
8.             d(ar(i, 2)) = 1
   
9.         End If
   
10.         ar(i, 1) = d(ar(i, 2))
    
11.     Next
    
12.     [a3].CurrentRegion = ar
    
13. End Sub

复制代码

lsc900707

yunfei2018 发表于 2018-9-27 17:12
抱歉，补上测试附件，

附件供测试：

一把小刀闯天下

Option Explicit

Sub test()
  Dim i, arr, t1, t2, n
  arr = [a3].CurrentRegion.Offset(1)
  For i = 1 To UBound(arr, 1) - 1
    n = n + 1: arr(i, 1) = n
    t1 = Val(Split(Split(arr(i, 2), "年")(1), "月")(0))
    If Len(arr(i + 1, 2)) Then
      t2 = Val(Split(Split(arr(i + 1, 2), "年")(1), "月")(0))
    Else
      t2 = 0
    End If
    If t1 <> t2 Then n = 0
  Next
  [a4].Resize(UBound(arr, 1) - 1) = arr
End Sub

yunfei2018

4楼版主的字典方法与6楼仁兄的数组循环，都可以达到，学习了！
感谢！