Получение массива значений по критерию и копирование его на лист - VBA
Формулировка задачи:
Доброго времени суток! Уважаемые. Пожалуйста помогите решить задачу?
Есть табличка; В первом столбце - заказы, во втором соответствующее ему оборудование. Мне нужно загрузив табличку, например в словарь и запустив внешнюю программу отправить в неё первый заказ, потом открыв его вставить массив всего оборудования, что соответствует заказу (как вариант вставить на лист в столбик построчно) сохраняемся, переходим к следующему заказу...
Я в словаре получаю, то что мне нужно, но оборудование у меня через запятую в одной строке. Как получить его в массив, построчно?
Листинг программы
- Sub Масс_Зак()
- Dim a, b, i&, k, t$
- a = Selection.Value
- With CreateObject("scripting.dictionary")
- .comparemode = 1
- For i = 1 To UBound(a)
- t = a(i, 1) 'критерий, тут бы trim() ещё может нужен...
- If Not .exists(t) Then
- b = Application.Index(a, i, , 1)
- Else
- b = .Item(t)
- b(2) = b(2) & "," & a(i, 2)
- End If
- .Item(t) = b
- Next
- i = 1
- ' Обозначим переменные для заказа
- For Each k In .keys
- b = .Item(k)
- Zakaz = b(1)
- Оборудование = b(2)
- 'получить Оборудование в массив и выгрузить его на лист.
- Dim el, s
- s = Split(b(2), ",")
- For Each el In s
- ЕО = el
- Next
- Next
- Erase Array(s)
- Erase b
- End With
- End Sub
Решение задачи: «Получение массива значений по критерию и копирование его на лист»
textual
Листинг программы
- Sub Масс_Зак2()
- Dim a, b, i&, k, t$, tt$, zakaz
- Dim el
- a = Selection.Value
- With CreateObject("scripting.dictionary")
- .comparemode = 1
- For i = 1 To UBound(a)
- t = a(i, 1) 'критерий, тут бы trim() ещё может нужен...
- If Not .exists(t) Then
- b = Application.Index(a, i, , 1)
- tt = b(2)
- Set b(2) = CreateObject("System.Collections.ArrayList")
- b(2).Add tt
- Else
- b = .Item(t)
- b(2).Add a(i, 2)
- End If
- .Item(t) = b
- Next
- i = 1
- ' Обозначим переменные для заказа
- For Each k In .keys
- b = .Item(k)
- zakaz = b(1)
- 'получить Оборудование в массив и выгрузить его на лист.
- ' For Each el In b(2)
- 'Debug.Print zakaz & "-" & el
- i = i + 1
- Cells(i, 5) = zakaz
- Cells(i, 6).Resize(, b(2).Count) = b(2).toarray
- ' Next
- Next
- Erase b
- End With
- End Sub
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д