Vba 创建对称矩阵

我想学习如何在VBA中创建对称矩阵。例如，在第一步中，我想选择

范围（“C3:I3”）

，然后复制到

范围（“B4:B10”）

。在第二阶段，它应该选择

范围（“D4:I4”）

，然后复制到

范围（“C5:C10”）

。应该是这样的。

我有一些代码来做。所选单元格必须在数字范围内

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

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

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

► 守则：

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

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

---

你不需要VBA来做这件事。选择单元格并复制它们。选择目标范围的顶部单元格，使用“特殊粘贴”并勾选“转置”框

如果您真的需要VBA来完成这项工作，那么您肯定不需要像另一篇文章中建议的那样使用循环。只需在VBA代码中使用转置选项。对于大型数据集，这将比在每个单元中循环快得多

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

---

你想要实现什么还不清楚。Excel没有将8个单元格的范围复制到单个单元格的命令。你想干什么？编辑您的问题并提供更多详细信息。我不想粘贴到一个单元格（B4），这只是复制过程的起点。如果不清楚，我想将其粘贴到范围（“B4:B11”），谢谢。由于我的数据很大，很难对每个单元格使用相同的代码，这就是我需要循环的原因。