本文主要是介绍一个可自动生成行排号的excel VBA小工具,希望对大家解决编程问题提供一定的参考价值,需要的开发者们随着小编来一起学习吧!
如下图,点击“生成行排号”按钮即可生成想要的行排号
基本用法如下:
1、设置顺序排列的行排号(每排的行号一致,行的方向排序方向也一致)
2、设置顺序排列的行排号(行号从小到大排列,而不受排的限制)
3、设置之字排序的行排号(每排的行号一致,行的方向排序方向相反)
4、设置之字排序的行排号(行号从小到大排列,而奇偶排行的方向排序方向相反)
5、其他注意事项:
(1)排步长设置,只能是1或-1,即不能进行跳排的设置,当为1时排的排列是顺序,为-1时排列为倒序。
(2)行步长设置,可以设置为任意整数i。
(3)可以进行多种行排号的设置,依次列出,即可一次性生成所有行排号。
在最后把原始代码奉上,愿有兴趣的小伙伴可以继续优化设计:
Sub 生成行排号()'对变量进行定义
'c为列数,r为行数
'order_1为起始排序方式,order_2为排列方式
'start_row为起始行号,start_col为起始排号,b为是否需要越排计行
Dim c As Integer, r As Integer
Dim order_1 As String
Dim start_row As Integer, start_col As Integer, step_row As Integer, step_col As Integer
Dim b As String'其他变量为临时性变量
Dim rng As Range
Dim num As Integer, num_1 As Integer, num_2 As Integer
Dim i As Integer, j As Integer, l As Integer, m As IntegerApplication.ScreenUpdating = False '关闭屏幕刷新Set rng = Range(Worksheets("行排号设置").Range("A1"), Cells(Worksheets("行排号设置").Range("A10000").End(xlUp).Row, 8))If rng.Rows.Count > 1 Then '判断A列有无录入数据Range("L:M").Clear '清空M列和N列Range("L1").Value = "排号" '生成表头——排号Range("M1").Value = "行号" '生成表头——行号For num = 2 To rng.Rows.Count '对录入的数据进行遍历'将参数数据提供给变量c = rng(num, 1).Valuer = rng(num, 2).Valuestart_col = rng(num, 3).Valuestart_row = rng(num, 4).Valuestep_col = rng(num, 5).Valuestep_row = rng(num, 6).Valueorder_1 = rng(num, 7).Valueb = rng(num, 8).ValueIf order_1 = "顺序排列" ThenIf b = "是" Then '当行号跨排统计时l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1For num_1 = start_col To (start_col + c - 1) Step step_colFor j = 1 To rRange("L" & l).Value = num_1l = l + 1NextNextFor num_2 = start_row To start_row + (c * r - 1) * step_row Step step_rowRange("M" & m).Value = num_2m = m + 1NextElse '当行号不跨排统计时l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1For num_1 = start_col To (start_col + c - 1) Step step_colFor num_2 = start_row To (r + start_row - 1) * step_row Step step_rowRange("L" & l).Value = num_1l = l + 1Range("M" & m).Value = num_2m = m + 1NextNextEnd IfElseIf b = "是" Then '当行号跨排统计时l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1For num_1 = start_col To (start_col + c - 1) Step step_colFor j = 1 To rRange("L" & l).Value = num_1l = l + 1NextNext'定义起始排顺序,次排倒序,以此类推'用i对排进行计数,i为奇数时顺序,i为偶数时倒序i = 1For num_1 = start_col To (start_col + c - 1) Step step_colIf i Mod 2 ThenFor num_2 = start_row + ((i - 1) * r) * step_row To start_row + (i * r - 1) * step_row Step step_rowRange("M" & m).Value = num_2m = m + 1NextElseFor num_2 = start_row + (i * r - 1) * step_row To start_row + ((i - 1) * r) * step_row Step -1 * step_rowRange("M" & m).Value = num_2m = m + 1NextEnd Ifi = i + 1NextElse '当行号不跨排统计时l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1i = 1For num_1 = start_col To (start_col + c - 1) Step step_col'定义起始排顺序,次排倒序,以此类推'用i对排进行计数,i为奇数时顺序,i为偶数时倒序If i Mod 2 ThenFor num_2 = start_row To (r + start_row - 1) * step_row Step step_rowRange("L" & l).Value = num_1l = l + 1Range("M" & m).Value = num_2m = m + 1NextElseFor num_2 = (r + start_row - 1) * step_row To start_row Step -1 * step_rowRange("L" & l).Value = num_1l = l + 1Range("M" & m).Value = num_2m = m + 1NextEnd Ifi = i + 1NextEnd IfEnd IfNext
ElseMsgBox "无数据"
End IfApplication.ScreenUpdating = True '重新打开屏幕刷新End Sub
这篇关于一个可自动生成行排号的excel VBA小工具的文章就介绍到这儿,希望我们推荐的文章对编程师们有所帮助!