绵阳市建设银行网站,p2p网站建设时间,联系客户做网站,微信微网站开发策划本程序用于应对随机区组试验中要求相同小区位置不能出现同一品种的情况。编程思路略有不同#xff0c;故将另开一篇。 本试验设计是在原来的基础上改版的#xff0c;相关的参数设置与操作同上一版#xff0c;这里不在赘述#xff1a;一个可以自动生成随机区组试验的excel V… 本程序用于应对随机区组试验中要求相同小区位置不能出现同一品种的情况。编程思路略有不同故将另开一篇。 本试验设计是在原来的基础上改版的相关的参数设置与操作同上一版这里不在赘述一个可以自动生成随机区组试验的excel VBA小程序-CSDN博客 实现代码如下
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, k As Integer
Dim arr As Variant, rngValues As Variant, tmp As VariantApplication.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 Thenws.Name sn 将新工作表的名称设置为新工作表
End If 将范围内的值存储在数组中
rngValues rng.Value
ReDim arr(1 To UBound(rngValues), 1 To qz_num) As VariantFor i 1 To qz_numFor j 1 To (lastRow - 1) 对数组进行赋值arr(j, i) rngValues(j, 1)Next
NextFor i 1 To qz_num 随机排列数组中的元素
rnd:Randomize 初始化随机数生成器For m LBound(arr) To UBound(arr) - 1n Int((UBound(arr) - m 1) * rnd m) 交换元素tmp arr(m, i)arr(m, i) arr(n, i)arr(n, i) tmpNext mIf i 1 ThenFor k 1 To (i - 1)For j 1 To (lastRow - 1)If arr(j, k) arr(j, i) ThenGoTo rndEnd IfNextNextEnd If
NextIf pq 否 Then 没有排区号的情况Select Case plCase 横向输入行标题For i 1 To qz_numws.Cells(i, 1).Value 区组 iNext将品种名称放入对应行排号的单元格中For j 1 To qz_num 对行号循环For i 2 To lastRow 对列号循环ws.Cells(j, i).Value arr(i - 1, j)NextNextSet rng2 Range(ws.Cells(1, 1), ws.Cells(j - 1, i - 1))对单元格进行居中设置ws.Cells(1, 1).CurrentRegion().HorizontalAlignment xlCenterws.Cells(1, 1).VerticalAlignment xlCenter对田间种植区域添加边框With rng2.Borders.LineStyle xlContinuous.Weight xlThin.Color RGB(0, 0, 0) 黑色End WithCase 纵向输入列标题For i 1 To qz_numws.Cells(1, i).Value 区组 iNext将品种名称放入对应行排号的单元格中For j 1 To qz_num 对列号循环For i 2 To lastRow 对行号循环ws.Cells(i, j).Value arr(i - 1, j)NextNextSet rng2 Range(ws.Cells(1, 1), ws.Cells(i - 1, j - 1))对单元格进行居中设置ws.Cells(1, 1).CurrentRegion().HorizontalAlignment xlCenterws.Cells(1, 1).VerticalAlignment xlCenter对田间种植区域添加边框With rng2.Borders.LineStyle xlContinuous.Weight xlThin.Color RGB(0, 0, 0) 黑色End WithCase ElseMsgBox 无此排列类型请重新选择End Select
Else 有排区号的情况Select Case plCase 横向输入行标题For i 1 To qz_num * 2 Step 2ws.Cells(i, 1).Value 排区号NextFor i 2 To qz_num * 2 Step 2ws.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)NextElse 对行号进行判断若为偶数则输入品种名称For i 2 To lastRow 对列号循环ws.Cells(j, i).Value arr(i - 1, (Int(j / 2)))NextEnd IfNextSet rng2 Range(ws.Cells(1, 1), ws.Cells(j - 1, i - 1))对单元格进行居中设置ws.Cells(1, 1).CurrentRegion().HorizontalAlignment xlCenterws.Cells(1, 1).VerticalAlignment xlCenter对田间种植区域添加边框With rng2.Borders.LineStyle xlContinuous.Weight xlThin.Color RGB(0, 0, 0) 黑色End WithCase 纵向输入列标题For i 1 To qz_num * 2 Step 2ws.Cells(1, i).Value 排区号NextFor i 2 To qz_num * 2 Step 2ws.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)NextElse 对列号进行判断若为偶数则输入品种名称For i 2 To lastRow 对列号循环ws.Cells(i, j).Value arr(i - 1, (Int(j / 2)))NextEnd IfNextSet rng2 Range(ws.Cells(1, 1), ws.Cells(i - 1, j - 1))对单元格进行居中设置ws.Cells(1, 1).CurrentRegion().HorizontalAlignment xlCenterws.Cells(1, 1).VerticalAlignment xlCenter对田间种植区域添加边框With rng2.Borders.LineStyle xlContinuous.Weight xlThin.Color RGB(0, 0, 0) 黑色End WithCase ElseMsgBox 无此排列类型请重新选择End Select
End IfApplication.ScreenUpdating True 刷新屏幕开启
Application.DisplayAlerts True 警告提示框开启End Sub
