VBA делает ориентированный граф неориентированным

У меня есть таблица Excel с 2 столбцами, которая определяет отношения между 2 вершинами (серверами). К сожалению, столбцов слишком много, поэтому есть записи A,B и B,A. Мне нужно избавиться от этих лишних записей. Может кто-нибудь предоставить функцию, пожалуйста?

Пример:

введите описание изображения здесь

Предпочел бы, чтобы вывод был разделен, но это нормально, если он изменяет те же столбцы ввода.

1 ответ

Решение

Отвечая на этот вопрос, я надеюсь, что это даст вам отправную точку или идею, чтобы понять основы и придумать ваше наполовину рабочее решение в следующий раз.

Без VBA:

Вы можете сравнить строки. В камере D2 -> =IF(A2<B2,A2,B2) дает вам первую букву в алфавите среди двух букв. То же самое относится и к E2 -> =IF(A2<B2,B2,A2), Скопируйте эти формулы до конца, затем скопируйте / вставьте их как значения, а затем удалите дубликаты с ленты данных.

Используя VBA:

Вы можете изменить порядок букв, используя сравнение снова, а затем объединить их с запятой между ними. Затем проверьте их, если они существуют в вашем словаре и добавьте их в словарь, если они не существуют. Вы можете записать их в ячейки листа в процессе, или вы можете извлечь их из вашего словаря позже:

Sub removeDub()
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
Dim s1, s2 As String
'Dim a() As String

With Sheets("Sheet1")
For i = 2 To .Range("A1").End(xlDown).Row
    If Cells(i, 1).Value < Cells(i, 2).Value Then
        s1 = .Cells(i, 1).Value
        s2 = .Cells(i, 2).Value
    Else
        s1 = .Cells(i, 2).Value
        s2 = .Cells(i, 1).Value
    End If

    If Not dict.Exists(s1 & "," & s2) Then
        dict.Add s1 & "," & s2, 1
        .Range("D" & .Cells.Rows.Count).End(xlUp).Offset(1) = s1
        .Range("E" & .Cells.Rows.Count).End(xlUp).Offset(1) = s2
    End If
Next i

'For Each Key In dict.Keys
'    a = Split(Key, ",")
'    .Range("D" & .Cells.Rows.Count).End(xlUp).Offset(1) = a(0)
'    .Range("E" & .Cells.Rows.Count).End(xlUp).Offset(1) = a(1)
'Next Key
End With

End Sub
Другие вопросы по тегам