Уменьшение массива с повторяющимися значениями

[Anastasia5]

Добрый день!
Есть табличка с повторяющимися названиями городов в столбцах и некоторыми показателями.
Например, Тула-Кострома-6, Кострома-Тула-1.
Требуется представить таблицу в виде Тула-Кострома-7 (сумма значений).
Таблица соответственно уменьшится в 2 раза.
Во вложении - то, что имею в виду (xlsx ver. Windows 2010).
Буду признательна за совет, как сделать это автоматически. Прошу оставить встроенные формулы в файле.

[Aleksandr H.]

Вариант решения. Лист2. Допили по нужде

[Казанский]

Александр, снимаю шляпу, но макросом ИМХО удобнее

Sub Anastasia5()
Dim v(), i&, j&, k&, di As Object
  Set di = CreateObject("scripting.dictionary")
  v = Range("A1", Cells(Rows.Count, "C").End(xlUp)).Value
  k = 1
  For i = 2 To UBound(v)
    If Not di.exists(v(i, 1) & v(i, 2)) Then
      If Not di.exists(v(i, 2) & v(i, 1)) Then
        k = k + 1
        For j = 1 To 3
          v(k, j) = v(i, j)
        Next
        j = 0
        di(v(i, 1) & v(i, 2)) = k
      Else
        j = di(v(i, 2) & v(i, 1))
      End If
    Else
      j = di(v(i, 1) & v(i, 2))
    End If
    If j Then v(j, 3) = v(j, 3) + v(i, 3)
  Next
  Range("G1").Resize(k, 3).Value = v
End Sub

[SAS888]

Можно так:

Private Sub CommandButton1_Click()
    Dim i As Long, s As String, a(), q: Application.ScreenUpdating = False
    a = Range("A2:C" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    Set q = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a, 1)
        s = a(i, 1) & "|" & a(i, 2)
        If q.Exists(s) Then
            q.Item(s) = q.Item(s) + a(i, 3)
        Else
            s = a(i, 2) & "|" & a(i, 1)
            If q.Exists(s) Then q.Item(s) = q.Item(s) + a(i, 3) Else q.Add s, a(i, 3)
        End If
    Next
    Range("G2:I" & Cells(Rows.Count, "G").End(xlUp).Row + 1).Delete xlUp
    With [G2].Resize(q.Count)
        .Value = Application.Transpose(q.Keys)
        .TextToColumns [G2], DataType:=xlDelimited, Other:=True, OtherChar:="|"
        .Resize(, 3).Borders.LineStyle = xlContinuous
    End With
    [I2].Resize(q.Count).Value = Application.Transpose(q.Items)
End Sub

Пример во вложении. Откройте файл и нажмите кнопку "Сформировать"

[Казанский]

На самом деле лучше не проверять словарь/коллекцию с тем или другим ключом, а формировать однозначный ключ для данной пары строк: меньшая строка & большая строка. Число обращение к словарю/коллекции существенно сокращается:

Sub Anastasia51()
Dim v(), i&, j&, k&, cl As New Collection, key$
  v = Range("A1", Cells(Rows.Count, "C").End(xlUp)).Value
  k = 1
  On Error Resume Next
  For i = 2 To UBound(v)
    If v(i, 1) < v(i, 2) Then key = v(i, 1) & v(i, 2) Else key = v(i, 2) & v(i, 1)
    j = cl(key)
    If Err Then
      k = k + 1
      For j = 1 To 3: v(k, j) = v(i, j): Next
      cl.Add k, key
      Err.Clear
    Else
      v(j, 3) = v(j, 3) + v(i, 3)
    End If
  Next
  Range("G1").Resize(k, 3).Value = v
End Sub