Question

我正在尝试从行组织的excel文件中建立边缘关系，

A，B，C，

D，E

目标是从每一行创建关系：

A，B

A，C

B，C

我有以下代码，问题是当行长度相等时代码是有效的，但是例如对于上面的行，它也会创建跟随边缘（关系）：

D，“”

E，“”

这对大型数据集造成了很大的问题。我想知道是否某些正文可以帮助我调整代码以创建边缘列表的方式，直到每行填充单元格。如果还有其他方法可以做到这一点，那么效率会更高。

非常感谢，会有很大的帮助。

我的代码：

Sub Transform()

Dim targetRowNumber As Long
targetRowNumber = Selection.Rows(Selection.Rows.Count).Row + 2

Dim col1 As Variant
Dim cell As Range
Dim colCounter As Long
Dim colCounter2 As Long

Dim sourceRow As Range: For Each sourceRow In Selection.Rows

    For colCounter = 1 To Selection.Columns.Count - 1


        col1 = sourceRow.Cells(colCounter).Value
        For colCounter2 = colCounter + 1 To Selection.Columns.Count
            Set cell = sourceRow.Cells(, colCounter2)

            If Not cell.Column = Selection.Column Then
                Selection.Worksheet.Cells(targetRowNumber, 1) = col1
                Selection.Worksheet.Cells(targetRowNumber, 2) = cell.Value
                targetRowNumber = targetRowNumber + 1
            End If

        Next colCounter2

    Next colCounter

Next sourceRow

End Sub

Answer 1

我玩过它 - 这应该可以解决问题。如果需要的话，我们可以通过输出到另一个变量数组来加速它，但这对我来说非常快：

Sub Transform_New()

Dim rngSource As Range, rngDest As Range
Dim varArray As Variant
Dim i As Integer, j As Integer, k As Integer

Set rngSource = Sheet1.Range("A1", Sheet1.Cells(WorksheetFunction.CountA(Sheet1.Columns(1)), 1)) 'Put all used rows into range
Set rngDest = Sheet1.Cells(WorksheetFunction.CountA(Sheet1.Columns(1)), 1).Offset(2, 0) 'Set target range to start 2 below source range

varArray = Range(rngSource, rngSource.Offset(0, Range("A1").SpecialCells(xlCellTypeLastCell).Column)).Value

For i = LBound(varArray, 1) To UBound(varArray, 1) 'Loop vertically through array
    For j = LBound(varArray, 2) To UBound(varArray, 2)    'Loop horizontally through each line apart from last cell
        k = j
        Do Until varArray(i, k) = ""
                k = k + 1
                If varArray(i, k) <> "" Then
                    rngDest.Value = varArray(i, j)
                    rngDest.Offset(0, 1).Value = varArray(i, k)
                    Set rngDest = rngDest.Offset(1, 0)
                End If
        Loop
    Next
Next

End Sub

如何调整代码以获得更好的性能

1 个答案: