Курортные массивы

Question

Я получаю данные, которые мне нужно вывести в виде строки:

123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C

Данные, которые я получаю, сортируются по буквам (A, B или C), а затем передаются мне по номеру. Итак, у меня есть три динамических массива, как:

ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567

Обратите внимание, что индекс, соответствующий конкретному 3-значному номеру в данном массиве, не обязательно соответствует одному и тому же 3-значному номеру, например, Arraya (1) = 123 = ArrayB (2).

Массивы имеют произвольную длину (в A, B или C может быть любое количество чисел), но существует только три массива.

Это позволяет легко выводить что-то вроде:

123 - A
234 - A
345 - B
123 - B
567 - B
123 - C
789 - C
567 - C

но это НЕ мой желаемый результат.

Мне нужно в этом формате:

123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C

Чтобы поиграть с этой проблемой напрямую, вот код, который генерирует «легкую» строку:

Dim ArrayA(2), ArrayB(3), ArrayC(3) As Integer, Output As String
ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567

For i=1 to 2
     Output = Output & ArrayA(i) & " - A" & vbNewLine
Next i
For i=1 to 3
     Output = Output & ArrayB(i) & " - B" & vbNewLine
Next i
For i=1 to 3
     Output = Output & ArrayC(i) & " - C" & vbNewLine
Next i

MsgBox(Output)

Как уже упоминалось выше, я надеюсь переместить формат так, чтобы он был организован по трехзначному номеру, а не по буквам.

---

Моя лучшая попытка найти решение - это записать данные в таблицу Excel, отсортировать их соответствующим образом и вернуть обратно в VBA, что кажется излишне уродливым. Например:

For i=1 to Len(ArrayA)+Len(ArrayB)+Len(ArrayC)
    If i < Len(ArrayA) Then
        Range("A:"&i).Value = ArrayA(i)
        Range("B:"&i).Value = "A,"
    End If
    If i > Len(ArrayA) And i <= Len(ArrayA) + Len(ArrayB) Then
        Range("A:"&i).Value = ArrayB(i)
        Range("B:"&i).Value = Range("B:"&i).Value & "B,"
    End If
    if i >= Len(ArrayA)+Len(ArrayB) Then
        Range("A:"&i).Value = ArrayC(i)
        Range("B:"&i).Value = Range("B:"&i).Value & "C,"
Next i

Тогда я мог бы отсортировать это, найти дубликаты и правильно объединить их, и, наконец, получить правильный результат:

123 - A, B, C
234 - A
345 - B
567 - B, C
789 - C

Answer 1

Похоже на хороший вариант использования словарей:

ArrayA(1) = 123
ArrayA(2) = 234
ArrayB(1) = 345
ArrayB(2) = 123
ArrayB(3) = 567
ArrayC(1) = 123
ArrayC(2) = 789
ArrayC(3) = 567

'...

Dim e, dictArrays, dictOut, k

Set dictArrays = Createobject("scripting.dictionary")
Set dictOut = Createobject("scripting.dictionary")

dictArrays.Add "A", ArrayA
dictArrays.Add "B", ArrayB
dictArrays.Add "C", ArrayC

For Each k in dictArrays.Keys
    For Each e in dictArrays(k)
        If dictOut.Exists(e) then
           dictOut(e) = dictOut(e) & "," & k  
        Else
           dictOut.Add e, k
        End If
    Next e
Next k

'output the result
For Each k in dictOut.Keys
    Debug.Print k, dictOut(k)
Next k

Answer 2

Попробуйте следующее:

Sub PopulateFromArrays()

Call WriteArray(ArrayA, "A")
Call WriteArray(ArrayB, "B")
Call WriteArray(ArrayC, "C")

End Sub


Function WriteArray(MyArray, MyString)

i = 2
For j = LBound(MyArray) To UBound(MyArray)
    ValueFound = False
    k = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To k
        If Range("A" & i).Value = MyArray(j) Then
            Range("B" & i).Value = Range("B" & i).Value & ", " & MyString
            ValueFound = True
            Exit For
        End If
    Next i
    If ValueFound = False Then
        Range("A" & k + 1).Value = MyArray(j)
        Range("B" & k + 1).Value = MyString
    End If
Next j

End Function

К вашему сведению, для проверки я заполнил массивы следующим текстом:

ArrayA = Array(123, 456, 789)
ArrayB = Array(123, 567, 912)
ArrayC = Array(456, 789, 567)

И результат был: