Разбивка данных ячеек по стобцам.

andre1994

Пользователь

Сообщений: 134 Регистрация: 30.11.2018

17.10.2019 13:40:44

Добрый день многоуважаемые умельцы!

Помогите пожалуйста со следующей задачей!
Есть массив данных содержащий порядка 4000 ячеек с данными. Как сделать так, чтобы чтобы данные из ячеек столбца А были разделены по разным столбцам.

Первая группа ячейки которой содержат в себе фразы "Клубная цена" и "Обычная цена". Вторая группа с фразами "По акции" и "Обычная цена". и третья группа вообще без этих фраз(только с ценой). Предполагается, что во всех ячейках первой группы перед фразой "Клубная цена" всегда стоит пробел а после нее "Обычная цена"(Клубная цена:321p Обычная цена:369p). Различаются только сами цены по разным препаратам.

То же самое и во второй группе-перед фразой "По акции" стоит пробел а после идет фраза "Обычная цена"(По акции: 252p Обычная цена:302p). Т.е. идет название препарата( к примеру "Беталок ЗОК таблетки 100мг №30" потом пробел и "Клубная цена" и остальные данные(сама цена и обычная цена). То же самое и с фразой "По акции"(после нее идет обычная цена, а цены на разные препараты отличаются).

Также есть ячейки(третья группа), в которых отсутствуют вышеперечисленные фразы, а идет просто цена на препарат(к примеру Адонис-бром таб. №2 57p). В этом случае предполагается что все цены будут идти без пробела между значком рубля(т.е. 57р, 125р и тд), но с пробелом перед самой цифрой.

Цветом выделил ячейки чтобы было более наглядно видно что к чему "привязано"
Простите если очень путано объяснил, надеюсь в примере будет более понятно в чем суть)

Прикрепленные файлы

пример разбивки.xlsx (9.06 КБ)

Kuzmich

Пользователь

Сообщений: 8057 Регистрация: 21.12.2012

17.10.2019 15:07:29

Цитата
данные из ячеек столбца А были разделены по разным столбцам

Как вытащить наименование придумайте сами

Код

Sub Tablica()
Dim i As Long
Dim iLastRow As Long
 iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
 Range("C2:G" & iLastRow).ClearContents
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
  For i = 2 To iLastRow
    If InStr(1, Cells(i, "A"), "Клубная цена:") > 1 And _
       InStr(1, Cells(i, "A"), "По акции:") = 0 Then
      .Pattern = "Клубная цена:\d+p"
      Cells(i, "C") = .Execute(Cells(i, "A"))(0)
    End If
    If InStr(1, Cells(i, "A"), "Обычная цена:") > 1 And _
       InStr(1, Cells(i, "A"), "По акции:") = 0 Then
      .Pattern = "Обычная цена:\d+p"
      Cells(i, "D") = .Execute(Cells(i, "A"))(0)
    End If
    If InStr(1, Cells(i, "A"), "Обычная цена:") > 1 And _
       InStr(1, Cells(i, "A"), "По акции:") > 1 Then
      .Pattern = "По акции: \d+p"
      Cells(i, "E") = .Execute(Cells(i, "A"))(0)
      .Pattern = "Обычная цена:\d+p"
      Cells(i, "F") = .Execute(Cells(i, "A"))(0)
    End If
    If InStr(1, Cells(i, "A"), "Клубная цена:") = 0 And _
       InStr(1, Cells(i, "A"), "Обычная цена:") = 0 And _
       InStr(1, Cells(i, "A"), "По акции:") = 0 Then
      .Pattern = "\d+p"
      Cells(i, "G") = .Execute(Cells(i, "A"))(0)
    End If
  Next
 End With
End Sub

Изменено: Kuzmich - 17.10.2019 15:08:14

Wiss Пользователь Сообщений: 1028 Регистрация: 08.11.2016	#3 17.10.2019 15:19:39 Наименование я формулой вытянул. Прикрепленные файлы пример разбивки (1).xlsx (10.41 КБ) Я не волшебник, я только учусь.

andre1994 Пользователь Сообщений: 134 Регистрация: 30.11.2018	#4 17.10.2019 15:27:59 Спасибо большое за помощь!!!

БМВ Модератор Сообщений: 23349 Регистрация: 28.12.2016 Excel 2013, 2016	#5 17.10.2019 17:11:32 Клубные и прочие =IFERROR(MID(LEFT($A3;FIND(" ";$A3&" ";FIND(C$1;$A3)+LEN(C$1)+2));FIND(C$1;$A3);999);"") Наименование и по заказу добьем. Прикрепленные файлы Copy of пример1199.xlsx (10.6 КБ) По вопросам из тем форума, личку не читаю.