按不同单位名称自动排列序号，谢谢！

ztd123

按不同单位名称自动排列序号，谢谢！

一把小刀闯天下

Option Explicit

Private Sub CommandButton1_Click()
  Dim i, j, k, n
  For i = 5 To Cells(Rows.Count, "b").End(xlUp).Row
    For j = i To Cells(Rows.Count, "b").End(xlUp).Row
      If Cells(j, "b") <> Cells(j + 1, "b") Then
        n = 0
        For k = i To j: n = n + 1: Cells(k, "a") = n: Next
        i = j: Exit For
      End If
  Next j, i
End Sub

ztd123

一把小刀闯天下 发表于 2018-7-3 10:19
Option Explicit

Private Sub CommandButton1_Click()

谢谢您，您真棒！再次感谢！

Kaohsing

'//js
Sub kao()
   
    Dim js As Object, r%
    Set js = CreateObject("ScriptControl"):    js.Language = "JScript"
    r = [B5].End(4).Row:     a = Range("B5:B" & r)
    js.addcode "function aa(a){return new VBArray(a).toArray();}"
    js.addObject "a", js.codeobject.aa(a)
    js.addObject "rg", [a5]
    js.eval"var k=0, t=a[0];for(i=0;i<a.length;i++){if(a==t){ rg(i+1,1)=k+1;k++}else{rg(i+1,1)=1,t=a,k=0,k++;} }"
   
End Sub