Копирование части слова с заменой из одного столбца в другой

Страница 1 из 1 1
Модератор форума: китин, _Boroda_, DrMini

Копирование части слова с заменой из одного столбца в другой (Макросы/Sub)

wwizard

Дата: Пятница, 23.02.2018, 13:05 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 176

Репутация: 0 ±

Замечаний: 40% ±

Есть огромная таблица. Каждое утро приходит по почте. В ней самое главное - это первая колонка, и шестая.
Первая колонка - это артикль товара, он создается выгрузкой с базы. Но чтото програмисты напутали и приходится делать ручками. Что реально очень нужно:

- Можно както придумать скриптом, чтобы в первую колонку вынеслось - все что в скобках во второй.
- Далее все что в скобках во второй, но имеет пробел, автоматически вставилось нижнее подчеркивание _ (пометил зеленым цветом) - и также переносилось уже с подчеркиванием в первый
- И гдавный вопрос - там где скобок нет, но артикль присуствует, чтоб либо его не трогало, либо также переместил в первую колонку (пометил голубым цветом)

Кусок файла приложил - цветами пометил что и как. Очень прошу помощи, так как - [кнопка запись макроса] - мне здесь не поможет. Буду очень признателен за посильную помощь.

К сообщению приложен файл: proba1.xlsx (11.8 Kb)

Ответить

Kuzmich

Дата: Пятница, 23.02.2018, 19:34 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 715

Репутация: 157 ±

Замечаний: 0% ±

Excel 2003

Цитата

Можно как-то придумать скриптом, чтобы в первую колонку вынеслось - все что в скобках во второй.

Для примера выносит в столбец G
[vba]

Код

Sub ВыделитьВскобках()
Dim i As Long
Dim iLastRow As Long
Dim iMatches As Object
iLastRow = Cells(Rows.Count, "B").End(xlUp).Row
    'очищаем диапазон
Range("G1:G" & iLastRow).ClearContents
With CreateObject("vbscript.regexp")
  .Global = True
  .IgnoreCase = True
     'цикл по ячейкам столбца B
    For i = 2 To iLastRow
     .Pattern = "\(.*?(?=\))"
      If .test(Cells(i, "B")) Then
        Set iMatches = .Execute(Cells(i, "B"))
          If InStr(1, iMatches(0), " ") <> 0 Then
            Cells(i, "G") = Mid(iMatches(0), 2)
            Cells(i, "G").Replace what:=" ", replacement:="_"
          Else
            Cells(i, "G") = Mid(iMatches(0), 2)
          End If
      Else
        Cells(i, 7) = Cells(i, 2)
      End If
    Next
End With
End Sub

[/vba]