全部自动编号小班

Sub paixu(ByRef xian_arr as Collection)
maxnban = 0
maxban = 0
Dim lindi_arr As New Collection

For i= 1 To xian_arr.Count Step 1
If xian_arr(i) < 8000 Then
lindi_arr.Add Cells(i, 1).Value
End If
If maxnban < xian_arr(i) Then
maxnban = xian_arr(i)
End If
i = i + 1
Next

For i = 1 To lindi_arr.Count Step 1
If maxban < lindi_arr(i) Then
maxban = lindi_arr(i)
End If
Next

 

End Sub

 

 

 

 

 

 

i = 1
Dim xian_arr As New Collection
only_one_xiaoban = true
cun_xiaoban_end = false

Do While Cells(i, 1).Value <> ""

If Cells(i,1).Value = Cells(i+1,1) Then
xian_arr.Add Cells(i,1).Value
only_one_xiaoban = false
End If
If only_one_xiaoban = true Then
Cells.(i,3).Value = Cells.(i,1).Value
End If
If Cells(i,1).Value <> Cells(i+1,1) and only_one_xiaoban = false Then
xian_arr.Add Cells(i+1,1)
only_one_xiaoban = true
cun_xiaoban_end = true
End If
If cun_xiaoban_end = true Then

Next

End If

Loop

 

 

2：

 

Sub paixu(ByRef xian_arr As Collection, ByRef result_start)
maxnban = 0
maxban = 0

Dim lindi_arr As New Collection

For i = 1 To xian_arr.Count Step 1
If maxnban < xian_arr(i) Then
maxnban = xian_arr(i)
End If
Next

For i = 1 To xian_arr.Count Step 1
If xian_arr(i) < 8000 Then
lindi_arr.Add xian_arr(i)
End If
Next

For i = 1 To lindi_arr.Count Step 1
If maxban < lindi_arr(i) Then
maxban = lindi_arr(i)
End If
Next

Cells(result_start + 1, 3).Value = xian_arr(1)

For i = 1 To xian_arr.Count - 1 Step 1

If xian_arr(i) <> xian_arr(i + 1) Then
Cells(result_start + i + 1, 3).Value = xian_arr(i + 1)
End If

If xian_arr(i) = xian_arr(i + 1) And xian_arr(i) < 8000 Then
maxban = maxban + 1
Cells(result_start + i + 1, 3).Value = maxban
End If

If xian_arr(i) = xian_arr(i + 1) And xian_arr(i) >= 8000 Then
maxnban = maxnban + 1
Cells(result_start + i + 1, 3).Value = maxnban
End If
Next

For i = 1 To xian_arr.Count Step 1
xian_arr.Remove (1)
Next

 

End Sub

 

 

 

Sub test()

i = 1
Dim xian_arr As New Collection
only_one_xiaoban = True
cun_xiaoban_end = False
result_start = 0

Do While Cells(i, 1).Value <> ""

If Cells(i, 1).Value = Cells(i + 1, 1) Then
xian_arr.Add Cells(i, 2).Value
only_one_xiaoban = False
End If

If only_one_xiaoban = True Then
Cells(i, 3).Value = Cells(i, 2).Value
result_start = i
End If

If Cells(i, 1).Value <> Cells(i + 1, 1) And only_one_xiaoban = False Then
xian_arr.Add Cells(i, 2)
cun_xiaoban_end = True
End If

If cun_xiaoban_end = True Then
only_one_xiaoban = True
paixu xian_arr, result_start
result_start = i
cun_xiaoban_end = False
End If

i = i + 1

Loop

End Sub