一、功能
输入Excel数据样例:第一行、第一列分别代表研究个体,表格主体是距离矩阵,如下列数据中第二行、第三列表示ind1与ind2的距离。使用该VBA代码时需选中这一数据区域,然后再运行代码。
ind1ind2ind3ind1NA23ind22NA5ind335NA
输出数据格式:程序会自动新建一个“Trans_result”工作表,其中数据格式如下:
ind1ind2Distanceind1ind22ind1ind33ind2ind35
警告: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
转载请注明原文地址:https://blackberry.8miu.com/read-3130.html