创建对称矩阵

Question

我想学习如何在VBA中创建对称矩阵。例如，在第一步中，我想选择Range("C3:I3")，然后复制到Range("B4:B10")。在第二阶段，应选择Range("D4:I4")，然后复制到Range("C5:C10")。它应该继续这样。

Answer 1

我有一些代码可以做到这一点。您选择的单元格必须在数字范围内。

<强> 1。如果对角线为空。

►

代码：

Sub making_symmetric_matrix()

Dim i As Long, j As Long
Dim rng As Range
Set rng = Selection.CurrentRegion
Dim rngStart As Range
Set rngStart = Cells(rng.Row, rng.Column - 1)

For i = 1 To rng.Rows.Count
    For j = i To rng.Columns.Count
        rngStart.Offset(j, i - 1).Value = rngStart.Offset(i - 1, j).Value
    Next
Next

End Sub

的 2。如果对角线不为空。

►

代码：

Sub making_symmetric_matrix2()

Dim i As Long, j As Long
Dim rng As Range
Set rng = Selection.CurrentRegion
Dim rngStart As Range
Set rngStart = Cells(rng.Row, rng.Column)

For i = 1 To rng.Rows.Count
    For j = i To rng.Columns.Count
        rngStart.Offset(j - 1, i - 1).Value = rngStart.Offset(i - 1, j - 1).Value
    Next
Next

End Sub

Answer 2

你不需要VBA来做到这一点。选择单元格并复制它们。选择目标范围的顶部单元格，使用“选择性粘贴”并勾选“移调”框。

如果你真的需要VBA这样做，你肯定不需要在另一篇文章中建议的循环。只需使用VBA代码中的转置选项即可。对于大型数据集，这将比循环每个单元格快得多。

    Range("C3:I3").Copy
    Range("B4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True