0

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

A,B,C,

D,E

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

甲，乙

A,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
4

1 回答 1

0

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

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
于 2013-01-25T09:56:02.410 回答