编程技术、软件应用与系统模拟

(Programming, Applicaiton and Simulation)


		本站目录
		首页 ASP/Access/IIS DELPHI/PASCAL PASCAL高级编程 C语言编程实例 WORD Excel MATLAB MINITAB讲座 Windows DOS SAS 生物系统模拟土壤水分剖析器其他


		镜像站点
		主站北美镜象站欧洲镜象站(1) 欧洲镜象站(2)

座右铭:
只做有益人类的事
不做有害人类的事

An example for generating experimental layout

Zhanshan Dong

Dr. Roe asked me to generate a pot map for her growth chamber experiments. Since she will do the experiments again and again. One fixed map is not good. I wrote some VBA code in Excel and create an Excel Add-in. This program can generate pot layout randomly. All you have to do is put the Add-in under Library folder in Microsoft office. In excel, use Tools->Add-in command, check RiceLayout add-in in the dialog. After done, one menuitem called "Rice Layout" will show in Tools menu. Click it, one dialog window popup, just choose how many trays per chamber ran, number of rows (pot) per tray, number of column (pot) per tray, click Ok button.
You can change the code and adapt to your problem easily.

Private Sub btnCancel_Click()
    Hide
End Sub

Private Sub btnOK_Click()
    Dim trays, rows, columns
    If tbTray.Value <> "" Then
        trays = CInt(tbTray.Value)
    Else
        trays = 4
    End If
    If tbRow.Value <> "" Then
        rows = CInt(tbRow.Value)
    Else
        rows = 4
    End If
    If tbColumn.Value <> "" Then
        columns = CInt(tbColumn.Value)
    Else
        columns = 3
    End If
    generate_random_number trays, rows, columns
    Hide
    Unload frmRandom
End Sub

Sub generate_random_number(trays, rows, columns)
        
    ReDim myrand(2, 12)
    
    pots = rows * columns
    If pots <> 12 Then
        ReDim myrand(2, pots)
    End If
    halfpots = pots \ 2
    halfpots1 = pots - halfpots
    
    Start = 0
    For i = 1 To trays
        ' make sure the number of pots per variety is divided evenly
        If (i > trays \ 2) Then halfpots = halfpots1
        
        ' generate the random number
        Randomize
        For j = 1 To halfpots
            myrand(1, j) = 1
            myrand(2, j) = Rnd
        Next
        For j = halfpots + 1 To pots
            myrand(1, j) = 2
            myrand(2, j) = Rnd
        Next
        
        ' sort the data
        For j = 1 To pots
            For k = 1 To pots
                If myrand(2, k) < myrand(2, j) Then
                    temp = myrand(2, j)
                    myrand(2, j) = myrand(2, k)
                    myrand(2, k) = temp
                    temp = myrand(1, j)
                    myrand(1, j) = myrand(1, k)
                    myrand(1, k) = temp
                End If
            Next
        Next
    
        ' output the data
        m = 0
        For j = 1 To rows
            For k = 1 To columns
                m = m + 1
                Cells(j + Start, k).Value = myrand(1, m)
            Next k
        Next j
    Start = Start + rows + 1
    Next i
End Sub

Private Sub UserForm_Initialize()
    tbTray.Text = "4"
    tbRow.Text = "4"
    tbColumn.Text = "3"
End Sub

Option Explicit

Private Sub ricerandomize()
    frmRandom.Show
End Sub

Private Sub auto_open()
    Dim ToolsBar As CommandBarPopup
    Dim newButton As CommandBarButton
    Set ToolsBar = Application.CommandBars("Worksheet Menu Bar").Controls("Tools")
    Set newButton = ToolsBar.Controls.Add(msoControlButton)
    With newButton
        .Caption = "RiceExp &Layout"
        .OnAction = "ricerandomize"
    End With
    Set newButton = Nothing
    Set ToolsBar = Nothing
End Sub

Private Sub Auto_Close()
    On Error Resume Next
    Dim ToolsBar As CommandBarPopup
    Dim newButton As CommandBarButton
    Set ToolsBar = Application.CommandBars("Worksheet Menu Bar").Controls("Tools")
    Set newButton = ToolsBar.Controls("RiceExp &Layout")
    newButton.Delete
    Set ToolsBar = Nothing
    Set newButton = Nothing
End Sub