макрос по копированию одного-двух слов в заданную ячейку

Дата: Среда, 04.01.2017, 19:42 | Сообщение № 1

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

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

Сообщений: 176

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

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

Мелочный вопросик. Есть огромный прайс. Нужно из столбца №3 скопировать первых два слова в столбец 24. НО главная проблема заключается в том. что два слова нужно только там где есть кириллица. Там же где после первого слова стоит слово на английском языке, или скобка - то копироваться должно только первое слово.

Например:
Акустика Logitech S150 Digital USB Speaker System (980-000029) OEM
копируем, только: Акустика

а, содержимое ячейки:
Карта памяти Kingston 4GB NAND Flash microSDHC SD2,0 Class 4 (SDC4/4GBSP)
копируем: Карта памяти

Пример приложил

К сообщению приложен файл: proga-kat.xlsx (13.1 Kb)

Сообщение отредактировал wwizard - Среда, 04.01.2017, 19:42

SLAVICK

Дата: Среда, 04.01.2017, 20:10 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

придумалось два варианта:
ЮДФ-ка:
[vba]

Код

Function d(s$, Optional p$ = "[А-я ]+")
    Set R = CreateObject("vbscript.regexp")
    R.Pattern = p: R.Global = False
    Set m = R.Execute(s)
    d = m(0)
End Function

[/vba]

формула массива:

Код

=СЖПРОБЕЛЫ(ЛЕВСИМВ(C5;МИН(ЕСЛИ(ЕСЛИОШИБКА((КОДСИМВ(ПСТР(C5;СТРОКА($A$1:$A$99);1))<192)*(ПСТР(C5;СТРОКА($A$1:$A$99);1)<>" ");0);СТРОКА($A$1:$A$99);99))-1))

К сообщению приложен файл: proga-kat.xlsm (19.4 Kb)

Иногда все проще чем кажется с первого взгляда.

Дата: Среда, 04.01.2017, 22:42 | Сообщение № 3

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

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

Сообщений: 176

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

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

Цитата SLAVICK, 04.01.2017 в 20:10, в сообщении № 2 ()

ЮДФ-ка:

[vba]

Код

Sub un()

Function d(s$, Optional p$ = "[?-? ]+")
    Set R = CreateObject("vbscript.regexp")
    R.Pattern = p: R.Global = False
    Set m = R.Execute(s)
    d = m(0)
End Function

End Sub

[/vba]

Пишет ошибку.

Сообщение отредактировал wwizard - Среда, 04.01.2017, 22:43

SLAVICK

Дата: Среда, 04.01.2017, 22:54 | Сообщение № 4

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

Стесняюсь спросить - а зачем вы ЮДФ-ку запихнули во внутрь макроса?

.
Посмотрите как в моем файле сделано - чем не подходит?

Иногда все проще чем кажется с первого взгляда.

Дата: Среда, 04.01.2017, 23:05 | Сообщение № 5

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

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

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

2003

А пример SLAVICKа открыть и посмотреть, сложно?
[p.s.]Сам опередил.

[/p.s.]

Сообщение отредактировал Wasilich - Среда, 04.01.2017, 23:06

Дата: Четверг, 05.01.2017, 00:12 | Сообщение № 6

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

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

Сообщений: 176

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

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

Цитата SLAVICK, 04.01.2017 в 22:54, в сообщении № 4 ()

Посмотрите как в моем файле сделано - чем не подходит?

да, но тогда мне везде надо ставить копировать ячейку, и утягивать ее вниз. А там 10000 строк. поэтому и засунул в макрос. думал запускать под ALT+F8

SLAVICK

Дата: Четверг, 05.01.2017, 09:57 | Сообщение № 7

Группа: Модераторы

Ранг: Старожил

Сообщений: 2290

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

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

2019

Цитата wwizard, 05.01.2017 в 00:12, в сообщении № 6 ()

А там 10000 строк.

так что мешает протянуть формулу вниз до последней строки, а потом скопировать-вставить как значения?

Цитата wwizard, 05.01.2017 в 00:12, в сообщении № 6 ()

копировать ячейку, и утягивать ее вниз.

а вот здесь вообще не понял - куда "утягивать"

? в примере то все слева в той же строке.

Иногда все проще чем кажется с первого взгляда.

Дата: Четверг, 05.01.2017, 11:09 | Сообщение № 8

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

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

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

2003

Цитата wwizard, 05.01.2017 в 00:12, в сообщении № 6 ()

думал запускать под ALT+F8

А кнопкой не удобно?
Должно работать.
[vba]

Код

Sub ddd()
  Dim s$, p$, i&, R, m
  For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
    s = Cells(i, 3)
    p = "[А-я() ]+"
    Set R = CreateObject("vbscript.regexp")
    R.Pattern = p
    R.Global = False
    Set m = R.Execute(s)
    Cells(i, 24) = m(0)
  Next
End Sub

[/vba]

Сообщение отредактировал Wasilich - Четверг, 05.01.2017, 11:15

Дата: Четверг, 05.01.2017, 16:40 | Сообщение № 9

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

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

Сообщений: 176

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

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

Цитата Wasilich, 05.01.2017 в 11:09, в сообщении № 8 ()

А кнопкой не удобно?
Должно работать.

[vba]

Код

Sub ddd()
Dim s$, p$, i&, R, m
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
    s = Cells(i, 3)
    p = "[А-я() ]+"
    Set R = CreateObject("vbscript.regexp")
    R.Pattern = p
    R.Global = False
    Set m = R.Execute(s)
    Cells(i, 24) = m(0)
Next
End Sub

[/vba]

Ругается на: Cells(i, 24) = m(0)

Сообщение отредактировал wwizard - Четверг, 05.01.2017, 16:41

Дата: Четверг, 05.01.2017, 18:52 | Сообщение № 10

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

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

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

2003

Цитата wwizard, 05.01.2017 в 16:40, в сообщении № 9 ()

Ругается на: Cells(i, 24) = m(0)

В соответствии с примером, у меня не ругается.

К сообщению приложен файл: wwizard2.xls (56.5 Kb)

Дата: Пятница, 06.01.2017, 00:10 | Сообщение № 11

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

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

Сообщений: 176

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

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

В приложеный файл вставил весь прайс. нажал кнопку, получил:
1. Скрин http://prntscr.com/dryuor
2. Скрин http://prntscr.com/dryv1r

А вот и за чего ошибка, он нашел это: http://prntscr.com/dryvn1 ,
хотя тут не застопорился: http://prntscr.com/dryw8n - может можно както добавить правило, чтоб если только одно слово в ячейке, то его пропускать, считать что там ничего нет?

Сообщение отредактировал wwizard - Пятница, 06.01.2017, 00:10

Дата: Пятница, 06.01.2017, 01:24 | Сообщение № 12

Группа: Друзья

Ранг: Старожил

Сообщений: 1232

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

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

2003

После Dim вставить
[vba]

Код

On Error Resume Next

[/vba]может поможет. А скрины надо здесь выкладывать. А можно было просто пояснить, что ругается при отсутствии в тексте кириллицы.

Сообщение отредактировал Wasilich - Пятница, 06.01.2017, 01:39