0

行ごとに整理されたエクセルファイルから辺関係を作ろうとしていますが、

A、B、C、

D、E

目的は、各行から関係を作成することです。

A,B

交流

紀元前

私は次のコードを持っています。問題は、行の長さが等しい場合にコードが効率的であることですが、たとえば、上記の行の場合、次のエッジ (関係) も作成します。

D」「

え、「」

これは、大規模なデータセットに大きな問題を引き起こします。各行のセルがいっぱいになるまでエッジリストを作成する方法でコードを調整するのに役立つ人がいるのだろうかと思っていました。これをより効率的に行う他の方法があれば、それを高く評価します。

どうもありがとうございました。

私のコード:

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 に答える