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

    科技2022-07-11  112

    一、功能

    输入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
    Processed: 0.010, SQL: 8