本文于2023年10月3日首发于本人同名公众号：VBA编程实战，更多文章案例请搜索关注！
按多种条件生成序号完整代码
1、在模块1里，Generate过程：
Sub Generate()
Dim ws As Worksheet
Dim lastRow As Long
Dim firstNum As Integer
Dim lastNum As Long
Dim Prefix As String
Dim Suffix As String
Dim strExclude As String
Dim arrExclude() As String
Dim excludeType As String
Dim lengthNum As Integer
Dim arr(), rng As Range
Dim time As Single
time = Timer
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
lastRow = .UsedRange.Rows.Count
.Range("A2:A" & lastRow).Clear
firstNum = Val(.Range("D2").Value)
lastNum = Val(.Range("E2").Value)
Prefix = .Range("D5").Value
Suffix = .Range("E5").Value
strExclude = .Range("D8").Value
arrExclude = Split(strExclude, "、")
= "/" & Join(arrExclude, "/") & "/"
excludeType = .Range("E8").Value
lengthNum = Val(.Range("D11").Value)
'检查数字序号长度参数，不能小于结束数字的位数。
'下面的IF判断基本不会有真的情况出现，在工作表的Change事件中已做了检查、控制
'确保D11的值不小于E2数字的长度。
If Len(CStr(lastNum)) > lengthNum Then
MsgBox "数字长度最小为：" & Len(CStr(lastNum))
Exit Sub
End If
If firstNum > lastNum Then
MsgBox "起始数字应小于结束数字！"
Exit Sub
End If
For i = firstNum To lastNum
'根据排号方式处理数据
If excludeType = "号值" Then
If InStr(strExclude, "/" & i & "/") > 0 Then
GoTo NextFor
End If
ElseIf excludeType = "尾号" Then
If InStr(strExclude, "/" & Right(i, 1) & "/") > 0 Then
GoTo NextFor
End If
ElseIf excludeType = "任意" Then
m = 0
For j = LBound(arrExclude) To UBound(arrExclude)
If InStr(CStr(i), arrExclude(j)) Then
m = 1
End If
Next
If m = 1 Then
GoTo NextFor
End If
End If
'把不符合排除条件的i序号写入数组arr
ReDim Preserve arr(k)
arr(k) = Prefix & Format(i, Application.WorksheetFunction.Rept("0", lengthNum)) & Suffix
k = k 1
NextFor: '根据前面排除条件设置，满足排除条件的i,跳过写入数组部分的代码，进入下一次循环。
Next
Set rng = .Range("A2").Resize(UBound(arr) 1, 1)
rng.NumberFormatLocal = "@"
Dim arrTem()
ReDim arrTem(1 To UBound(arr) 1, 1 To 1)
For i = LBound(arr) To UBound(arr)
arrTem(i 1, 1) = arr(i)
Next
rng = arrTem
End With
MsgBox "Done! Time used:" & Timer - time
End Sub
代码解析：
（1）Line2~13，定义一些变量。把各个参数都定义为变量。
（2）line17~27，把工作表单元格的各种参数，存到变量里，方便引用。把排除方式strExclude按“、”符号分列到数组，再把数组以“/”符号Join为字符串，存到变量strExclude中。这样做的目的是在数字前后加上限定符，以便完整匹配。
（3）line31~34，检查数据序号长度参数，不能小于终止值数字的位数，但这里的控制基本不可能被触发，因为在工作表的Change事件中已进行了控制。
（4）line36~39，检查起始值不能大于终止值，这里也可以在工作表Change事件中控制（但没有）。
（5）line40~66，循环起始值到终止值，生成序号。
（A）line42~45，判断排除方式，如果是“号值”的，则跳过存在于strExclude中的i值。
（B）line46~49，判断排除方式，如果是“尾号”的，则跳过尾数存在于strExclude中的i值。
（C）line50~59，判断排除方式，如果是“任意”的，则跳过有任意一位数存在于strExclude中的i值。
（7）line62~64，把不符合排除条件的i序号，加上前缀、后缀写入数组arr。
（8）line67~68，设置与数组同样大小的Range对象，设置数字格式为文本。主要目的是，如果没有前后缀，是纯数字序号的话，能保证序号前的0正常显示。
（9）line69~74，把arr写入一个多行一列的二维数组arrTem，然后直接写入工作表。arr是一维行数组，在数据量很大的情况下，用Transpose函数转置会有问题，会出现错误值。
2、在模块1里，copyResults、clearData过程：：
Sub copyResults()
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.UsedRange.Rows.Count
'删除可能存在的空白已使用单元格。
For i = 2 To lastRow
If ws.Cells(i, 1) = "" Then
ws.Range(Cells(i, 1), Cells(lastRow, 1)).Delete shift:=xlUp
Exit For
End If
Next
If i > 2 Then
ws.Range("A2:A" & i - 1).copy
Else
MsgBox "没有可复制的数据！"
End If
End Sub
Sub clearData()
Dim ws As Worksheet
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.UsedRange.Rows.Count
ws.Range("A2:A" & lastRow).Clear
End Sub
代码解析：
（1）Line1~18，copyResults复制生成的序号。
（A）line7~12，删除A列空白单元格，以免复制到空白的单元格。（感觉应该有别的简单的方法？）
（B）line13~17，判断一下刚才循环跳出时的i，也就是第一个空白单元格，如果i不大于2，说明没有数据可复制；否则，复制A2到A&i-1单元格。
（2）line20~26，clearData清除数据过程。把生成的序号清空，主要是为了演示起来看得清楚。
3、在工作表Sheet1里，Change事件：
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastNum As Long
Dim lengthNum As Integer
Dim strNum As String
lastNum = Val(Range("E2").Value)
strNum = CStr(lastNum)
lengthNum = Val(Range("D11").Value)
If Target.Address = "$D$11" Then
If lengthNum < Len(strNum) Then
MsgBox "数字长度最小为：" & Len(strNum)
Target.Value = Len(strNum)
Exit Sub
End If
ElseIf Target.Address = "$E$2" Then
If Target.Value > 1000000 Then
MsgBox "数据过大!"
Target.Value = 1000000
Exit Sub
End If
If lengthNum < Len(strNum) Then
Range("D11").Value = Len(strNum)
End If
End If
End Sub
代码解析：
（1）Line8~13，如果数字长度（D11单元格）的值发生改变，检查它的值不能小于终止值（E2单元格）的位数，否则，则把D11的值改为E2值的位数。
（2）line15~19，如果终止值（E2单元格）的值发生改变，检查它的值不超过1百万（Excel最大行是1048576），再检查数字长度（D11单元格）的值，若D11的值小于E2单元格数字的位数，则把D11的值改为E2值的位数。
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
Copyright © 2024 妖气游戏网 www.17u1u.com All Rights Reserved
