Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Сцепить данные из нескольких ячеек в одну - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Сцепить данные из нескольких ячеек в одну
Katrin1954 Дата: Среда, 18.09.2024, 11:35 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Добрый день!
Длительное время работали по макросу, который позволял перенести данные по модификациям двигателей одной модели в новый столбец в одной ячейке через ; и пробел. Однако в один момент макрос резко перестал работать, выдавая ошибку "Invalid procedure call or argument". Всё уже, что знали, перепробовали, но так и не поняли в чём проблема.
Задача стоит следующая: собрать все данные одной модели автомобиля столбца B в одну ячейку столбца D через ; и пробел, при этом заключив каждую модификацию в скобки, и так по каждой модели. Исходная таблица, как она выгружается с сайта Плэнтикар https://plentycar.ru/autopart/6177209 представлена на листе 1. На листе 2 представлено то, что должно получиться. Макрос, которым мы пользовались, тоже в разработчике прописан.
Может, получится решить проблему не через макрос, а формулами как-то...
К сообщению приложен файл: makros_komplektacija.xlsm (19.7 Kb)
 
Ответить
СообщениеДобрый день!
Длительное время работали по макросу, который позволял перенести данные по модификациям двигателей одной модели в новый столбец в одной ячейке через ; и пробел. Однако в один момент макрос резко перестал работать, выдавая ошибку "Invalid procedure call or argument". Всё уже, что знали, перепробовали, но так и не поняли в чём проблема.
Задача стоит следующая: собрать все данные одной модели автомобиля столбца B в одну ячейку столбца D через ; и пробел, при этом заключив каждую модификацию в скобки, и так по каждой модели. Исходная таблица, как она выгружается с сайта Плэнтикар https://plentycar.ru/autopart/6177209 представлена на листе 1. На листе 2 представлено то, что должно получиться. Макрос, которым мы пользовались, тоже в разработчике прописан.
Может, получится решить проблему не через макрос, а формулами как-то...

Автор - Katrin1954
Дата добавления - 18.09.2024 в 11:35
Hugo Дата: Среда, 18.09.2024, 11:59 | Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3595
Репутация: 779 ±
Замечаний: 0% ±

365
В третьем столбце макросу объёма не хватает.
Ну или заменить 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]


webmoney: E265281470651 Z422237915069
USDT TRC20: TN8XeEF17o5KPBD9pNwYzNyruycuAc2mVD


Сообщение отредактировал Hugo - Среда, 18.09.2024, 12:09
 
Ответить
СообщениеВ третьем столбце макросу объёма не хватает.
Ну или заменить 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]

Автор - Hugo
Дата добавления - 18.09.2024 в 11:59
Katrin1954 Дата: Среда, 18.09.2024, 12:18 | Сообщение № 3
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Hugo, всё заработало. Огромное человеческое спасибо!
 
Ответить
СообщениеHugo, всё заработало. Огромное человеческое спасибо!

Автор - Katrin1954
Дата добавления - 18.09.2024 в 12:18
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!