Excel VBA两两个体距离矩阵转化为数据库格式

一、功能

• 输入Excel数据样例：第一行、第一列分别代表研究个体，表格主体是距离矩阵，如下列数据中第二行、第三列表示ind1与ind2的距离。使用该VBA代码时需选中这一数据区域，然后再运行代码。

	ind1	ind2	ind3
ind1	NA	2	3
ind2	2	NA	5
ind3	3	5	NA

• 输出数据格式：程序会自动新建一个“Trans_result”工作表，其中数据格式如下：

ind1	ind2	Distance
ind1	ind2	2
ind1	ind3	3
ind2	ind3	5

• 警告：1、确保原始数据矩阵是对称阵，否则不符合实际意义；2、确保运行代码前，Excel中没有名为“Trans_result”的工作表(Worksheet)。

二、VBA代码

Sub mat_to_data()
    Dim Sht As Worksheet
    Dim Rng As Range
    Dim choice As Boolean
    Set Rng = Selection
    
    If Rng.Rows.Count <> Rng.Columns.Count Then
        choice = MsgBox("选择区域不是矩阵", vbCritical)
        GoTo fail:
    End If
    Set Sht = Sheets.Add()
    Sht.Name = "Trans_result"
    Range("A1").Select
    ActiveCell.Value = "Ind1"
    ActiveCell.Offset(0, 1).Value = "Ind2"
    ActiveCell.Offset(0, 2).Value = "Distance"
    ActiveCell.Offset(1, 0).Select
    
    For Each cell In Rng
        If (cell.Row > Rng.Cells(1, 1).Row) And (cell.Column _
            > Rng.Cells(1, 1).Column) And ((cell.Row - Rng.Cells(1, 1).Row) < _
            (cell.Column - Rng.Cells(1, 1).Column)) Then
            ActiveCell.Value = cell.Offset(0, Rng.Cells(1, 1).Column - cell.Column).Value
            ActiveCell.Offset(0, 1) = cell.Offset(Rng.Cells(1, 1).Row - cell.Row, 0).Value
            ActiveCell.Offset(0, 2) = cell.Value
            ActiveCell.Offset(1, 0).Select  
        End If
    Next cell
fail:
End Sub