如何用VBA动态生成每列对应2行的试验设计对角矩阵

核心规则匹配 #

完全匹配需求定义的生成逻辑：

• 变量数支持用户动态输入，取值范围1-200
• 面点矩阵规格：行数为变量数的2倍，列数等于变量数；非当前遍历列单元格固定填充0.5，当前列按顺序依次填入1、0
• 角点矩阵规格：行列数均等于变量数，为标准对角矩阵，对角线位置值为1，其余位置值为0
• 写入位置：自动新建工作表，面点矩阵从新表C11单元格起始写入，角点矩阵紧接面点矩阵结束位置的下一行开始写入

完整VBA代码 #

Sub GenerateDesignMatrix()
    Dim n As Integer
    Dim ws As Worksheet
    Dim startRow As Long, startCol As Long
    Dim faceEndRow As Long
    Dim i As Long, j As Long
    
    ' 获取用户输入的变量数
    On Error Resume Next
    n = InputBox("请输入变量数（1-200）：", "参数设置")
    On Error GoTo 0
    
    ' 输入合法性校验
    If n <= 0 Or n > 200 Then
        MsgBox "请输入1-200之间的有效整数", vbExclamation
        Exit Sub
    End If
    
    ' 新建结果工作表
    Set ws = Worksheets.Add(after:=ActiveSheet)
    ws.Name = "试验设计矩阵_" & n & "变量"
    startRow = 11
    startCol = 3 ' 对应C列
    
    ' 关闭屏幕更新提升大变量数场景下的运行速度
    Application.ScreenUpdating = False
    
    ' 生成面点矩阵
    For i = 1 To n ' 逐列遍历填充
        ' 每列对应2行特征值：1、0，其余行该列固定填0.5
        For j = 1 To 2 * n
            If j = 2 * (i - 1) + 1 Then
                ws.Cells(startRow + j - 1, startCol + i - 1) = 1
            ElseIf j = 2 * i Then
                ws.Cells(startRow + j - 1, startCol + i - 1) = 0
            Else
                ws.Cells(startRow + j - 1, startCol + i - 1) = 0.5
            End If
        Next j
    Next i
    
    ' 计算角点矩阵起始行
    faceEndRow = startRow + 2 * n - 1
    ' 生成角点对角矩阵
    For i = 1 To n
        For j = 1 To n
            ws.Cells(faceEndRow + i, startCol + j - 1) = IIf(i = j, 1, 0)
        Next j
    Next i
    
    ' 自动调整列宽适配显示
    ws.Range(ws.Cells(startRow, startCol), ws.Cells(faceEndRow + n, startCol + n - 1)).EntireColumn.AutoFit
    
    Application.ScreenUpdating = True
    MsgBox "矩阵生成完成，共生成" & 2 * n & "行面点、" & n & "行角点", vbInformation
End Sub

使用方法 #

• 打开需要使用该功能的Excel文件，按快捷键Alt+F11调出VBA编辑器
• 在左侧工程资源管理器中右键点击当前工作簿名称，依次选择「插入」-「模块」
• 将上述代码完整粘贴到打开的模块代码窗口中
• 按F5运行宏，在弹出的输入框中填入需要的变量数，确认后即可自动生成符合规则的试验设计矩阵

内容的提问来源于stack exchange，提问作者Margaret