Добрый день! Длительное время работали по макросу, который позволял перенести данные по модификациям двигателей одной модели в новый столбец в одной ячейке через ; и пробел. Однако в один момент макрос резко перестал работать, выдавая ошибку "Invalid procedure call or argument". Всё уже, что знали, перепробовали, но так и не поняли в чём проблема. Задача стоит следующая: собрать все данные одной модели автомобиля столбца B в одну ячейку столбца D через ; и пробел, при этом заключив каждую модификацию в скобки, и так по каждой модели. Исходная таблица, как она выгружается с сайта Плэнтикар https://plentycar.ru/autopart/6177209 представлена на листе 1. На листе 2 представлено то, что должно получиться. Макрос, которым мы пользовались, тоже в разработчике прописан. Может, получится решить проблему не через макрос, а формулами как-то...
Добрый день! Длительное время работали по макросу, который позволял перенести данные по модификациям двигателей одной модели в новый столбец в одной ячейке через ; и пробел. Однако в один момент макрос резко перестал работать, выдавая ошибку "Invalid procedure call or argument". Всё уже, что знали, перепробовали, но так и не поняли в чём проблема. Задача стоит следующая: собрать все данные одной модели автомобиля столбца B в одну ячейку столбца D через ; и пробел, при этом заключив каждую модификацию в скобки, и так по каждой модели. Исходная таблица, как она выгружается с сайта Плэнтикар https://plentycar.ru/autopart/6177209 представлена на листе 1. На листе 2 представлено то, что должно получиться. Макрос, которым мы пользовались, тоже в разработчике прописан. Может, получится решить проблему не через макрос, а формулами как-то...Katrin1954
В третьем столбце макросу объёма не хватает. Ну или заменить 2 на 4, но детали ещё нужно подправить... Вот, там Эксель своевольничал, так победим: [vba]
Код
Sub Макрос1() Dim arr1, arr2, st As String arr1 = Range("A2:D" & Cells(Rows.Count, 3).End(xlUp).Row) ReDim arr2(1 To UBound(arr1), 1 To 1) For n = UBound(arr1) To LBound(arr1) Step -1 If Not arr1(n, 3) = "" Then st = "(" & arr1(n, 3) & "); " & st If Not arr1(n, 4) = "" Then arr2(n, 1) = "'" & Left(st, Len(st) - 2): st = "" Next Range("E2").Resize(UBound(arr2), 1) = arr2 End Sub
[/vba]
В третьем столбце макросу объёма не хватает. Ну или заменить 2 на 4, но детали ещё нужно подправить... Вот, там Эксель своевольничал, так победим: [vba]
Код
Sub Макрос1() Dim arr1, arr2, st As String arr1 = Range("A2:D" & Cells(Rows.Count, 3).End(xlUp).Row) ReDim arr2(1 To UBound(arr1), 1 To 1) For n = UBound(arr1) To LBound(arr1) Step -1 If Not arr1(n, 3) = "" Then st = "(" & arr1(n, 3) & "); " & st If Not arr1(n, 4) = "" Then arr2(n, 1) = "'" & Left(st, Len(st) - 2): st = "" Next Range("E2").Resize(UBound(arr2), 1) = arr2 End Sub
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
