全部自动编号小班
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