一个可以自动生成随机区组试验的excel VBA小程序

最新推荐文章于 2024-09-10 18:24:44 发布
最新推荐文章于 2024-09-10 18:24:44 发布
阅读量653 收藏 5
点赞数 5
分类专栏： 育种及测试相关工具 文章标签： excel 小程序 VBA 随机区组设计
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/maizeman126/article/details/139271077
版权

        在作物品种区域试验时，通常会采用随机区组试验设计，特制作了一个可以自动生成随机区组试验的小程序。excel参数界面如下：

参数含义如下：

1、生成新表的名称：程序将新建表格，用于生成随机区组试验。若此处为空，则为系统默认的新建表格名称，若含有名称，则新建表以此名称命名。

2、是否含排区号：若选择“是”，则以“1-1”的形式显示第几排，第几个小区。若选择“否”，则不显示，仅在标题处显示区组名称。

3、区组内品种排列方向：若为“横向”，则表格中在同一行中排列一个区组的不同品种；如选择“纵向”，则表格中在同一列中排列一个区组的不同品种。

4、区组数量：表示需要设置的区组数量，通常为3。

以上图中默认的设置运行代码，显示结果如下：

具体实现代码如下：

Sub 生成试验设计()

Dim ws As Worksheet, tg_ws As Worksheet
Dim rng As Range, rng2 As Range
Dim cell As Range, lastcell As Range
Dim pq As String, sn As String, pl As String   'pq即排区号的简称,sn即sheetname的简称,pl即排列的简称
Dim qz_num As Integer
Dim i As Integer, j As Integer, lastRow As Integer
Dim m As Integer, n As Integer
Dim arr As Variant, rngValues As Variant, tmp As Variant

Application.ScreenUpdating = False       '刷新屏幕关闭
Application.DisplayAlerts = False        '警告提示框关闭



'获取初始设置
sn = Range("A2").Value    '新建工作表的名称
pq = Range("A5").Value   '是否包含排区号
pl = Range("A8").Value    '试验设计是横向排列还是纵向排列
qz_num = Range("A11").Value    '区组的数量


'获取品种名称
lastRow = Range("C10000").End(xlUp).Row    '获取品种名称列的最后一行的行号
Set rng = Range("C2:C" & lastRow)


' 新建一个工作表，用于生成随机区组试验设计
Set ws = ThisWorkbook.Sheets.Add
If sn <> "" Then
    ws.Name = sn       ' 将新工作表的名称设置为"新工作表"
End If

' 将范围内的值存储在数组中
rngValues = rng.Value
ReDim arr(UBound(rngValues)) As Variant

If pq = "否" Then    '没有排区号的情况
    Select Case pl
        Case "横向"
            
            '输入行标题
            For i = 1 To qz_num
                ws.Cells(i, 1).Value = "区组" & i
            Next
            
            '将品种名称放入对应行排号的单元格中
            For j = 1 To qz_num    '对行号循环
            
                ' 随机排列数组中的元素
                arr = rngValues
                Randomize ' 初始化随机数生成器
                For m = LBound(arr) To UBound(arr) - 1
                    n = Int((UBound(arr) - m + 1) * Rnd + m)
                    ' 交换元素
                    tmp = arr(m, 1)
                    arr(m, 1) = arr(n, 1)
                    arr(n, 1) = tmp
                Next m
                
                For i = 2 To lastRow    '对列号循环
                    ws.Cells(j, i).Value = arr(i - 1, 1)
                Next
            Next
            
            Set rng2 = Range(ws.Cells(1, 1), ws.Cells(j - 1, i - 1))
            '对单元格进行居中设置
            ws.Cells(1, 1).CurrentRegion().HorizontalAlignment = xlCenter
            ws.Cells(1, 1).VerticalAlignment = xlCenter
            '对田间种植区域添加边框
            With rng2.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(0, 0, 0) ' 黑色
            End With

            
        Case "纵向"
            '输入列标题
            For i = 1 To qz_num
                ws.Cells(1, i).Value = "区组" & i
            Next
            
            '将品种名称放入对应行排号的单元格中
            For j = 1 To qz_num    '对列号循环
            
                ' 随机排列数组中的元素
                arr = rngValues
                Randomize ' 初始化随机数生成器
                For m = LBound(arr) To UBound(arr) - 1
                    n = Int((UBound(arr) - m + 1) * Rnd + m)
                    ' 交换元素
                    tmp = arr(m, 1)
                    arr(m, 1) = arr(n, 1)
                    arr(n, 1) = tmp
                Next m
                
                For i = 2 To lastRow    '对行号循环
                    ws.Cells(i, j).Value = arr(i - 1, 1)
                Next
            Next
            
            Set rng2 = Range(ws.Cells(1, 1), ws.Cells(i - 1, j - 1))
            '对单元格进行居中设置
            ws.Cells(1, 1).CurrentRegion().HorizontalAlignment = xlCenter
            ws.Cells(1, 1).VerticalAlignment = xlCenter
            '对田间种植区域添加边框
            With rng2.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(0, 0, 0) ' 黑色
            End With
        
        Case Else
            MsgBox "无此排列类型，请重新选择"
        
    End Select
Else    '有排区号的情况
    Select Case pl
        Case "横向"
            
            '输入行标题
            For i = 1 To qz_num * 2 Step 2
                ws.Cells(i, 1).Value = "排区号"
            Next
            For i = 2 To qz_num * 2 Step 2
                ws.Cells(i, 1).Value = "品种名称"
            Next
            
            '将品种名称放入对应行排号的单元格中
            For j = 1 To qz_num * 2  '对行号循环
                If j Mod 2 = 1 Then    '对行号进行判断，若为奇数则输入排区号
                    For i = 2 To lastRow    '对列号循环
                        ws.Cells(j, i).Value = "'" & (Int(j / 2) + 1) & "-" & (i - 1)
                    Next
                Else    '对行号进行判断，若为偶数则输入品种名称
                
                    ' 随机排列数组中的元素
                    arr = rngValues
                    Randomize ' 初始化随机数生成器
                    For m = LBound(arr) To UBound(arr) - 1
                        n = Int((UBound(arr) - m + 1) * Rnd + m)
                        ' 交换元素
                        tmp = arr(m, 1)
                        arr(m, 1) = arr(n, 1)
                        arr(n, 1) = tmp
                    Next m
                    
                    For i = 2 To lastRow    '对列号循环
                        ws.Cells(j, i).Value = arr(i - 1, 1)
                    Next
  
                End If
                
            Next
            
            Set rng2 = Range(ws.Cells(1, 1), ws.Cells(j - 1, i - 1))
            '对单元格进行居中设置
            ws.Cells(1, 1).CurrentRegion().HorizontalAlignment = xlCenter
            ws.Cells(1, 1).VerticalAlignment = xlCenter
            '对田间种植区域添加边框
            With rng2.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(0, 0, 0) ' 黑色
            End With
            
        Case "纵向"
        
            '输入列标题
            For i = 1 To qz_num * 2 Step 2
                ws.Cells(1, i).Value = "排区号"
            Next
            For i = 2 To qz_num * 2 Step 2
                ws.Cells(1, i).Value = "品种名称"
            Next
            
            '将品种名称放入对应行排号的单元格中
            For j = 1 To qz_num * 2  '对列号循环
                If j Mod 2 = 1 Then    '对列号进行判断，若为奇数则输入排区号
                    For i = 2 To lastRow    '对列号循环
                        ws.Cells(i, j).Value = "'" & (Int(j / 2) + 1) & "-" & (i - 1)
                    Next
                Else    '对列号进行判断，若为偶数则输入品种名称
                
                    ' 随机排列数组中的元素
                    arr = rngValues
                    Randomize ' 初始化随机数生成器
                    For m = LBound(arr) To UBound(arr) - 1
                        n = Int((UBound(arr) - m + 1) * Rnd + m)
                        ' 交换元素
                        tmp = arr(m, 1)
                        arr(m, 1) = arr(n, 1)
                        arr(n, 1) = tmp
                    Next m
                    
                    For i = 2 To lastRow    '对列号循环
                        ws.Cells(i, j).Value = arr(i - 1, 1)
                    Next
  
                End If
                
            Next
            
            Set rng2 = Range(ws.Cells(1, 1), ws.Cells(i - 1, j - 1))
            '对单元格进行居中设置
            ws.Cells(1, 1).CurrentRegion().HorizontalAlignment = xlCenter
            ws.Cells(1, 1).VerticalAlignment = xlCenter
            '对田间种植区域添加边框
            With rng2.Borders
                .LineStyle = xlContinuous
                .Weight = xlThin
                .Color = RGB(0, 0, 0) ' 黑色
            End With
        Case Else
            MsgBox "无此排列类型，请重新选择"
        
    End Select
End If


Application.ScreenUpdating = True       '刷新屏幕开启
Application.DisplayAlerts = True        '警告提示框开启

End Sub

maizeman126
关注
专栏目录
excel vba 数据分析
weixin_34361881的博客
01-20 2801
(Visual Basic Application) VBA(Visual Basic for Application)是Microsoft Office系列软件的内置编程语言，其语法结构与Visual Basic编程语言互相兼容，采用的是面向对象的编程机制和可视化的编程环境。 第一节 标识符 一．定义 标识符是一种标识变量、常量、过程、函数、类等语言构成单位的符号，利用它可以完成对变量、...
excel统计分析——随机区组设计
maizeman126的博客
02-21 2987
把条件一致的试验单位分在同一区组，再将同一区组的实验单位随机分配给不同的处理，加大了区组间的可比性。随机区组设计（randomized block design）是根据局部控制原则，如将性别、体重、年龄、长势、环境条件等基本相同的试验单位归为一个区组，每一区组内的试验单位等于处理数，并将各区组的试验单位随机分配给各处理。随机区组设计师，不同区组间的试验单位允许存在差异，同一区组内的试验单位则要尽可能一致，且对区组内的试验单位要进行随机分配。其中：T为总变异，t为处理变异，R为区组变异，e为误差；
Python编写的随机分组小程序
03-18
输入总人数N和分组数n，即可进行随机分组（如果N不是n的整数倍，则n个小组中的人数会不相同）
人员随机分组
最新发布
m0_46280388的博客
09-10 427
云分组小程序为用户提供了一种便捷的团队分组解决方案。通过该程序，用户可以轻松创建男女比例平均的分组，并通过扫码、链接或口令三种方式邀请成员加入。系统自动确保每个小组男女均衡，最多相差一人。成员加入后，可以查看组别和成员列表，而管理员则能进行更细致的管理，如修改组名、导出名单、调整成员等。此外，小程序还支持随机分组、指定分组等多种分组模式，满足不同团队需求。这使得云分组小程序成为团队组织者和活动策划者的理想工具，提高了团队合作的效率和质量。
随机分组EXcel用
05-22
想为班级的学生随机分组吗？想随机找一个人起来回答问题吗？ 现在利用EXcel可以很好地解决这个问题了，只要你输入班级的学生名单就可以了。
C#做的随机分组小程序（亦可用于抽签,摇奖）
12-07
环境为vs2005，可用于随机分组 抽签 摇奖，很有效，代码容易理解，可帮助学习。
随机分组小工具
caowei880123的专栏
09-14 7464
这个小工具的由来是因为我们公司中午有个十几分钟的球赛，就是foclball，都要进行随机分组，按照序号分组12一组34一组56一组78一组，12对34，56对78，由此就有了以下分组的小工具给每个人随机一个序号，业余玩玩。。。   import random import os peoples=[] file_object = open('F:\\Study Summarize\
活动随机分组小程序-VBS-第一版
11-21
这个程序有BUG，已修改，从这里下载吧https://blog.csdn.net/infoworld/article/details/108699390。 说明: 1.每次搞活动都需要分组，比如20个人分3个组，如何才能更公平的分组，想到的只能是随机分组程序。 2.时间关系并没有实现男女平衡的分组，有时间的哥们可以自己实现。
一个可以自动生成随机区组试验的excel VBA小程序2
06-03
一个可以自动生成随机区组试验的excel VBA小程序2
多种办公功能的WORD VBA程序
VB973490770的专栏
08-14 650
word的VBA办公助手 源代码。
随机分组（菜鸟程序）
08-05
在输入需要分组的人时一定要用,隔开才可以实现 切忌
js实现分组随机显示程序
12-19
这是一个通过用js实现输入起始和结束号码实现分组的小程序
随机分组的代码
04-27
随机分组代码，但是比较局限。输入分组人数和需要分的组数即可，暂时不能支持不平均分组。
效率工具—— 随机分组
03-05
进行各种培训时对需要培训的人员随意进行分组，简单易用！
随机分配岗位的一个小程序
02-20
随机分配岗位的一个小程序随机分配岗位的一个小程序
python 布莱克舒尔斯_使用Python自带GUI tkinter编写一个期权价格计算器
weixin_29021291的博客
03-01 491
0 准备工作首先，确认环境中有numpy、scipy.stats和tkinter三个功能包。前两个功能包可用于Python的数学计算，比如使用numpy来生成随机数用于Monte Carlo模拟，以及使用scipy.stats包来计算正态分布概率累积函数，这两个功能包可以使用pip安装。而第三个功能包tkinter是Python自带的一个GUI系统，理论上已经整合在了你的Python环境中。所谓的...
随机分组
LiXiaoChao12138的博客
10-12 2823
根据人数或组数随机分组 student:一个班中所有学生的信息存入List,算出组数或人数,在List.size()中Random随机选int,取出依据index存入组,List中remove. for(组group){ for(人数people){ 人存入组 } } @Override//输入组数 public List randomByGroup(String claid, int g...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值