Получение массива значений по критерию и копирование его на лист - VBA

Узнай цену своей работы

Формулировка задачи:

Доброго времени суток! Уважаемые. Пожалуйста помогите решить задачу? Есть табличка; В первом столбце - заказы, во втором соответствующее ему оборудование. Мне нужно загрузив табличку, например в словарь и запустив внешнюю программу отправить в неё первый заказ, потом открыв его вставить массив всего оборудования, что соответствует заказу (как вариант вставить на лист в столбик построчно) сохраняемся, переходим к следующему заказу... Я в словаре получаю, то что мне нужно, но оборудование у меня через запятую в одной строке. Как получить его в массив, построчно?
Листинг программы
  1. Sub Масс_Зак()
  2. Dim a, b, i&, k, t$
  3. a = Selection.Value
  4. With CreateObject("scripting.dictionary")
  5. .comparemode = 1
  6. For i = 1 To UBound(a)
  7. t = a(i, 1) 'критерий, тут бы trim() ещё может нужен...
  8. If Not .exists(t) Then
  9. b = Application.Index(a, i, , 1)
  10. Else
  11. b = .Item(t)
  12. b(2) = b(2) & "," & a(i, 2)
  13. End If
  14. .Item(t) = b
  15. Next
  16. i = 1
  17. ' Обозначим переменные для заказа
  18. For Each k In .keys
  19. b = .Item(k)
  20. Zakaz = b(1)
  21. Оборудование = b(2)
  22. 'получить Оборудование в массив и выгрузить его на лист.
  23. Dim el, s
  24. s = Split(b(2), ",")
  25. For Each el In s
  26. ЕО = el
  27. Next
  28. Next
  29. Erase Array(s)
  30. Erase b
  31. End With
  32. End Sub

Решение задачи: «Получение массива значений по критерию и копирование его на лист»

textual
Листинг программы
  1. Sub Масс_Зак2()
  2.     Dim a, b, i&, k, t$, tt$, zakaz
  3.     Dim el
  4.  
  5.     a = Selection.Value
  6.     With CreateObject("scripting.dictionary")
  7.         .comparemode = 1
  8.         For i = 1 To UBound(a)
  9.             t = a(i, 1)   'критерий, тут бы trim() ещё может нужен...
  10.            If Not .exists(t) Then
  11.                 b = Application.Index(a, i, , 1)
  12.                 tt = b(2)
  13.                 Set b(2) = CreateObject("System.Collections.ArrayList")
  14.                 b(2).Add tt
  15.             Else
  16.                 b = .Item(t)
  17.                 b(2).Add a(i, 2)
  18.             End If
  19.             .Item(t) = b
  20.         Next
  21.         i = 1
  22.         ' Обозначим переменные для заказа
  23.        For Each k In .keys
  24.             b = .Item(k)
  25.             zakaz = b(1)
  26.             'получить Оборудование в массив и выгрузить его на лист.
  27.  
  28. '            For Each el In b(2)
  29.                'Debug.Print zakaz & "-" & el
  30.                i = i + 1
  31.                 Cells(i, 5) = zakaz
  32.                 Cells(i, 6).Resize(, b(2).Count) = b(2).toarray
  33. '            Next
  34.        Next
  35.         Erase b
  36.     End With
  37. End Sub

ИИ поможет Вам:


  • решить любую задачу по программированию
  • объяснить код
  • расставить комментарии в коде
  • и т.д
Попробуйте бесплатно

Оцени полезность:

15   голосов , оценка 3.6 из 5

Нужна аналогичная работа?

Оформи быстрый заказ и узнай стоимость

Бесплатно
Оформите заказ и авторы начнут откликаться уже через 10 минут
Похожие ответы