UDP вопрос решён)
Очень интересно было бы услышать мнение-совет-вашу версию кода...
Осмотрел уже все, что смог найти в инете... написал свой вариант, но выдает ошибку где-то
СПАСИБО!!!
Вот пытаюсь в который день создать код макроса для Visual Basic в Эксель 2013 года для заполнения знаков вопроса согласно примеру необходимого результата.
Основная проблема - строк 10000, неудобно делать это через связку сцепить+индекс+поискпоз с разделителем ;
Да ещё и важно избежать повторения уже вставленных строк.
Дано: 2 таблицы. Одна заполненная, на листе 1 , вторую на листе 2 нужно заполнить с помощью программируемого кода через макрос. Даю пример, по которому нужно проверить, что все работает. Все объединил на третьем листе, чтобы было удобно понять, что к чему.
Алгоритм действий:
1 Найти в таблице 1 первое совпадение сырья в столбце E
2 Вставить название подразделения из первого столбца таблицы 1. Вставить текстовый разделитель "; "
4 Найти в таблице 1 следующее совпадение сырья в столбце E
5 Если совпадение найдено, вставить название подразделения из первого столбца таблицы 1 и текстовый разделитель ";", только если оно ещё НЕ БЫЛО вставлено (избежать повторения).
6 Если совпадений больше не найдено, а последний символ ";", то удалить ";"
7 Если совпадений не было в принципе, то вставить текст "-"
Код макроса вот такой:| Код |
|---|
Sub ЗаполнитьПодразделения()
'Создаем объекты
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsResult As Worksheet
Dim rngSource As Range
Dim rngResult As Range
Dim lastRow As Long
Dim lastCol As Long
Dim strRaw As String
Dim arrData() As String
Dim strSeparator As String
'Инициализируем объекты
Set wb = ThisWorkbook
Set wsSource = wb.Sheets("Лист1")
Set wsResult = wb.Sheets("Лист2")
'Определяем последний ряд и последний заполненный столбец в таблице 1
lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row
lastCol = wsSource.Cells(1, wsSource.Columns.Count).End(xlToLeft).Column
'Берем данные из таблицы 1
Set rngSource = wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(lastRow, lastCol))
arrData = rngSource.Value
'Ищем совпадения в таблице 2
Set rngResult = wsResult.Range(wsResult.Cells(2, 3), wsResult.Cells(lastRow, 3))
For i = 1 To lastRow
strRaw = rngResult.Cells(i, 1).Value 'текущее сырье
For j = 1 To UBound(arrData, 1)
If arrData(j, 2) = strRaw Then 'совпадение найдено, добавляем подразделение
rngResult.Cells(i, 3).Value = rngResult.Cells(i, 3).Value & arrData(j, 1) & "; "
End If
Next j
If rngResult.Cells(i, 3).Value Like "*; " Then
rngResult.Cells(i, 3).Value = Left(rngResult.Cells(i, 3).Value, Len(rngResult.Cells(i, 3).Value) - 2)
ElseIf rngResult.Cells(i, 3).Value = "" Then
rngResult.Cells(i, 3).Value = "-"
End If
Next i
'Сообщаем о завершении
MsgBox "Заполнение подразделений завершено!", vbInformation, "Успех:)"
End Sub
|
