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

news2024/11/9 3:55:17

        在作物品种区域试验时,通常会采用随机区组试验设计,特制作了一个可以自动生成随机区组试验的小程序。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


本文来自互联网用户投稿,该文观点仅代表作者本人,不代表本站立场。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如若转载,请注明出处:http://www.coloradmin.cn/o/1794045.html

如若内容造成侵权/违法违规/事实不符,请联系多彩编程网进行投诉反馈,一经查实,立即删除!

相关文章

探索通信技术的未来:2024中国通信技术和智能装备产业博览会

探索通信技术的未来&#xff1a;2024通信技术产业专场 随着信息技术的飞速发展&#xff0c;通信技术已成为现代社会不可或缺的基础设施。2024年10月11日至13日&#xff0c;青岛将迎来一场通信技术的盛会——2024中国军民两用智能装备与通信技术产业博览会。本次博览会不仅将展…

调试线上资源文件失效问题

之前的老项目&#xff0c;突然报红&#xff0c;为了定位问题&#xff0c;使用注入和文件替换的方式进行问题定位&#xff01; 1.使用注入 但是刷新后就没有了&#xff0c;不是特别好用&#xff01; const jqScript document.createElement(script); jqScript.src https://…

视频推广短信:新时代的营销利器(视频短信XML接口示例)

随着移动互联网的普及&#xff0c;短信已经不再是简单的文字信息传递工具&#xff0c;而是逐渐演变为一种有效的推广手段。特别是当视频与短信结合时&#xff0c;它所带来的营销效率更是令人瞩目。 一、视频推广短信的特点 1.直观性&#xff1a;与传统的文字短信相比&#xf…

MySQL存储引擎的区别和比较

MyISAM存储引擎 MyISAM基于ISAM存储引擎&#xff0c;并对其进行扩展。它是在Web、数据仓储和其他应用环境下最常使用的存储引擎之一。MyISAM拥有较高的插入、查询速度&#xff0c;但不支持事务。 MyISAM主要特性有&#xff1a; 1、大文件&#xff08;达到63位文件长度&#x…

图片像素缩放,支持个性化自定义与精准比例调整,让图像处理更轻松便捷!

图片已经成为我们生活中不可或缺的一部分。无论是社交媒体的分享&#xff0c;还是工作文档的编辑&#xff0c;图片都扮演着至关重要的角色。然而&#xff0c;你是否曾经遇到过这样的问题&#xff1a;一张高清大图在上传时却受限于平台的大小要求&#xff0c;或者一张小图需要放…

PPT视频如何16倍速或者加速播放

有两种方式&#xff0c;一种是修改PPT本身&#xff0c;这种方式非常繁琐&#xff0c;不太推荐&#xff0c;还有一种就是修改视频本身&#xff0c;直接让视频是16倍速的视频即可。 如何让视频16倍速&#xff0c;我建议人生苦短&#xff0c;我用Python&#xff0c;几行代码&…

Kafka生产者消息异步发送并返回发送信息api编写教程

1.引入依赖&#xff08;pox.xml文件&#xff09; <dependencies> <dependency> <groupId>org.apache.kafka</groupId> <artifactId>kafka-clients</artifactId> <version>3.6.2</version> </dependency> </depende…

0基础学习区块链技术——推演猜想

大纲 去中心预防篡改付出代价方便存储 在《0基础学习区块链技术——入门》一文中&#xff0c;我们结合可视化工具&#xff0c;直观地感受了下区块的结构&#xff0c;以及链式的前后关系。 本文我们将抛弃之前的知识&#xff0c;从0开始思考和推演&#xff0c;区块链技术可能是如…

【必会面试题】快照读的原理

目录 前言知识点一个例子 前言 快照读&#xff08;Snapshot Read&#xff09;是数据库管理系统中一种特殊的读取机制&#xff0c;主要用于实现多版本并发控制&#xff08;MVCC, Multi-Version Concurrency Control&#xff09;策略&#xff0c;尤其是在MySQL的InnoDB存储引擎中…

hadoop疑难问题解决_NoClassDefFoundError: org/apache/hadoop/fs/adl/AdlFileSystem

1、问题描述 impala执行查询&#xff1a;select * from stmta_raw limit 10; 报错信息如下&#xff1a; Query: select * from sfmta_raw limit 10 Query submitted at: 2018-04-11 14:46:29 (Coordinator: http://mrj001:25000) ERROR: AnalysisException: Failed to load …

关于一些优化的知识

1、凸优化&#xff1a;一定可找到全局最优解 非凸优化&#xff1a;一般是局部最优解 2、无约束优化问题求解方法&#xff1a;梯度下降、拟牛顿法、高斯牛顿法、LM算法 3、 解释&#xff0c;就是右边的式子对应于就是当前这个xk这个点基础上朝着pk取走步长为a得到了对应的值&…

什么是Vector Database(向量数据库)?

什么是Vector Database(向量数据库)&#xff1f; 向量数据库是向量嵌入的有组织的集合&#xff0c;可以随时创建、读取、更新和删除。向量嵌入将文本或图像等数据块表示为数值。 文章目录 什么是Vector Database(向量数据库)&#xff1f;什么是嵌入模型(Embedding Model)&…

618精选好物盘点!五款必买力作合集,省钱又实用!

随着夏日的脚步越来越近&#xff0c;618购物节也如期而至&#xff0c;成为消费者们期待的年度购物盛宴。在这个全民狂欢的日子里&#xff0c;各种精选好物层出不穷&#xff0c;无论是追求高品质生活的你&#xff0c;还是希望提升日常效率的上班族&#xff0c;都能在这一天找到心…

【微服务】使用kubekey部署k8s多节点及kubesphere

kubesphere官方部署文档 https://github.com/kubesphere/kubesphere/blob/master/README_zh.md kubuctl命令文档 https://kubernetes.io/zh-cn/docs/reference/kubectl/ k8s资源类型 https://kubernetes.io/zh-cn/docs/reference/kubectl/#%E8%B5%84%E6%BA%90%E7%B1%BB%E5%9E…

QT_UI设计

mainwindow.h #ifndef MAINWINDOW_H #define MAINWINDOW_H#include <QMainWindow>QT_BEGIN_NAMESPACE //命名空间 namespace Ui { class MainWindow; } //ui_MainWindow文件里定义的类&#xff0c;外部声明 QT_END_NAMESPACEclass MainWindow : public QMainWindow {Q_O…

读书笔记-《软件定义安全》之一:SDN和NFV:下一代网络的变革

第1章 SDN和NFV&#xff1a;下一代网络的变革 1.什么是SDN和NFV 1.1 SDN/NFV的体系结构 SDN SDN的体系结构可以分为3层&#xff1a; 基础设施层由经过资源抽象的网络设备组成&#xff0c;仅实现网络转发等数据平面的功能&#xff0c;不包含或仅包含有限的控制平面的功能。…

debian支持中文

1. 安装依赖 apt-get install locales2. 设置字符集 dpkg-reconfigure locales 选择en_us.UF-8&#xff0c;其余全部取消 3.设置生效&#xff0c;无需重启系统 source /etc/default/locale 4. 查看是否生效 locale

高效内容分发:海外短剧推广平台的流媒体传输技术挑战与解决

随着海外短剧市场的蓬勃发展&#xff0c;如何高效地将短剧内容分发给全球观众成为了推广平台必须面对的一大挑战。在这一过程中&#xff0c;流媒体传输技术起着至关重要的作用。然而&#xff0c;由于网络环境的复杂性和多样性&#xff0c;流媒体传输面临着带宽限制、延迟等诸多…

(学习笔记)数据基建-元数据管理

&#xff08;学习笔记&#xff09;数据基建-元数据管理 什么是元数据元数据该如何管理工具化规范化 数据血缘 什么是元数据 简单来说就是描述数据的数据&#xff0c;更直白来说就是描述表名、表制作者、表字段、表生命周期、表存粗等信息的数据 元数据该如何管理 工具化 …

【备战蓝桥杯】蓝桥杯省一笔记:算法模板笔记(Java)

蓝桥杯 0、快读快写模板1、回文判定2、前缀和3、差分4、二分查找5、快速幂6、判断素数7、gcd&lcm8、进制转换9、位运算10、字符串常用API11、n的所有质因子12、n的质因子个数13、n的约数个数14、n阶乘的约数个数15、n的约数和16、阶乘 & 双阶乘17、自定义升序降序18、动…