vba - 如何遍历一个范围并用值填充另一个工作表的单元格？

Question

在我的 Excel 工作表中，我有这样的内容:

          1      2      3
         John   Paul   Mike     
1  John   0      1      1
2  Paul   1      0
3  Mike   1             0

这类似于对称矩阵。注意:

每个人都有一个身份证；

为简化起见，我将值设置为 1，但它们可以从 1 开始
到 20。0 永远是 0。还有一些空格。

我需要的是一个通过“矩阵”并将值以下列格式输出到另一个工作表的宏:

From     To     Strenght
  1      2        1
  1      3        1
  2      1        1
  3      1        1

这是我到目前为止所拥有的，但它不起作用，因为它返回错误“需要对象”，指向 strenghts .

Dim i As Integer, j As Integer, strenghts As Integer

    Set currentCell = Worksheets("Raw_Relationships").Cells(3, 3)

         For i = 1 To 145
         For j = 1 To 145

           If currentCell <> "" Then

             Set currentCell = Worksheets("Raw_Relationships").Cells(i, j).Offset(2, 3)
             Set strenghts = Worksheets("Raw_Relationships").Cells(i, j).Offset(2, 2).Value

             Set Worksheets("Gephi_Data").Cells(i, 1).Offset(150, 0).Value = i
             Set Worksheets("Gephi_Data").Cells(i, 2).Offset(150, 0).Value = j
             Set Worksheets("Gephi_Data").Cells(i, 3).Offset(150, 0).Value = strenghts

           End If

         Next j
         Next i

关于如何做到这一点的任何提示？

Answer 1

有很多方法可以实现您想要的。这是您想要的一个非常基本的示例。

假设您的工作表如下所示



使用此代码。我已经对代码进行了注释，以便您理解它不会有问题。如果你这样做，那么只需问:)

代码

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim i As Long, j As Long
    Dim rw As Long, col As Long

    '~~> Change this to the relevant sheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '~~> This is where the output will be generated
    rw = 2: col = 8

    With ws
        '~~> Create Headers of Output
        .Cells(1, col).Value = "From"
        .Cells(1, col + 1).Value = "To"
        .Cells(1, col + 2).Value = "Strength"

        '~~> Looping through rows
        For i = 3 To 5
            '~~> Looping through columns
            For j = 3 To 5
                '~~> Check if the cell is > 0
                If .Cells(i, j).Value > 0 Then
                    '~~> Write the `From` column
                    .Cells(rw, col).Value = .Cells(i, 1).Value
                    '~~> Write the `To` Column
                    .Cells(rw, col + 1).Value = .Cells(1, j).Value
                    '~~> Write the `Strength` Column
                    .Cells(rw, col + 2).Value = .Cells(i, j).Value
                    rw = rw + 1
                End If
            Next j
        Next i
    End With
End Sub

输出

我在 Col H 中生成输出向前。根据需要进行更改。