本文于2023年10月3日首发于本人同名其他平台，更多文章案例请搜索关注！
内容提要
按多种条件生成序号完整代码
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 + 1NextFor: '根据前面排除条件设置，满足排除条件的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 - timeEnd 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 IfEnd SubSub clearData() Dim ws As Worksheet Dim lastRow As Long Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.UsedRange.Rows.Count ws.Range("A2:A" & lastRow).ClearEnd 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 IfEnd Sub
代码解析：
（1）Line8~13，如果数字长度（D11单元格）的值发生改变，检查它的值不能小于终止值（E2单元格）的位数，否则，则把D11的值改为E2值的位数。
（2）line15~19，如果终止值（E2单元格）的值发生改变，检查它的值不超过1百万（Excel最大行是1048576），再检查数字长度（D11单元格）的值，若D11的值小于E2单元格数字的位数，则把D11的值改为E2值的位数。
~~~~~~End~~~~~~
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！