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