一个可自动生成行排号的excel VBA小工具

最新推荐文章于 2025-02-13 21:54:16 发布

maizeman126

最新推荐文章于 2025-02-13 21:54:16 发布

阅读量773

点赞数 11

分类专栏：育种及测试相关工具文章标签： excel VBA 行排号自动化

本文链接：https://blog.csdn.net/maizeman126/article/details/138259140

版权

育种及测试相关工具专栏收录该内容

30 篇文章

订阅专栏

如下图，点击“生成行排号”按钮即可生成想要的行排号

基本用法如下：

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 Integer


Application.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).Value
        r = rng(num, 2).Value
        start_col = rng(num, 3).Value
        start_row = rng(num, 4).Value
        step_col = rng(num, 5).Value
        step_row = rng(num, 6).Value
        order_1 = rng(num, 7).Value
        b = rng(num, 8).Value
        
        If order_1 = "顺序排列" Then
            If b = "是" Then                   '当行号跨排统计时
                l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1
                m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1
                For num_1 = start_col To (start_col + c - 1) Step step_col
                    For j = 1 To r
                        Range("L" & l).Value = num_1
                        l = l + 1
                    Next
                Next
                
                For num_2 = start_row To start_row + (c * r - 1) * step_row Step step_row
                    Range("M" & m).Value = num_2
                    m = m + 1
                Next
            Else                               '当行号不跨排统计时
                l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1
                m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1
                For num_1 = start_col To (start_col + c - 1) Step step_col
                    For num_2 = start_row To (r + start_row - 1) * step_row Step step_row
                        Range("L" & l).Value = num_1
                        l = l + 1
                        Range("M" & m).Value = num_2
                        m = m + 1
                    Next
                Next
            End If
        Else
            If b = "是" Then                   '当行号跨排统计时
                l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1
                m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1
                For num_1 = start_col To (start_col + c - 1) Step step_col
                    For j = 1 To r
                        Range("L" & l).Value = num_1
                        l = l + 1
                    Next
                Next
                '定义起始排顺序，次排倒序，以此类推
                '用i对排进行计数，i为奇数时顺序，i为偶数时倒序
                i = 1
                For num_1 = start_col To (start_col + c - 1) Step step_col
                    If i Mod 2 Then
                        For num_2 = start_row + ((i - 1) * r) * step_row To start_row + (i * r - 1) * step_row Step step_row
                            Range("M" & m).Value = num_2
                            m = m + 1
                        Next
                    Else
                        For num_2 = start_row + (i * r - 1) * step_row To start_row + ((i - 1) * r) * step_row Step -1 * step_row
                            Range("M" & m).Value = num_2
                            m = m + 1
                        Next
                    End If
                    i = i + 1
                Next
            Else                               '当行号不跨排统计时
                l = Worksheets("行排号设置").Range("L100000").End(xlUp).Row + 1
                m = Worksheets("行排号设置").Range("M100000").End(xlUp).Row + 1
                i = 1
                For num_1 = start_col To (start_col + c - 1) Step step_col
                    '定义起始排顺序，次排倒序，以此类推
                    '用i对排进行计数，i为奇数时顺序，i为偶数时倒序
                    If i Mod 2 Then
                        For num_2 = start_row To (r + start_row - 1) * step_row Step step_row
                            Range("L" & l).Value = num_1
                            l = l + 1
                            Range("M" & m).Value = num_2
                            m = m + 1
                        Next
                    Else
                        For num_2 = (r + start_row - 1) * step_row To start_row Step -1 * step_row
                            Range("L" & l).Value = num_1
                            l = l + 1
                            Range("M" & m).Value = num_2
                            m = m + 1
                        Next
                    End If
                    
                    i = i + 1
                Next
            End If
            
        End If
    Next
Else
    MsgBox "无数据"
End If

Application.ScreenUpdating = True          '重新打开屏幕刷新

End Sub