Поиск цифровых значений с копированием их в другую ячейку

Старая форма входа

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

Леха1982

Дата: Пятница, 08.02.2013, 17:30 | Сообщение № 1

Группа: Гости

Доброго времени суток!
Подскажите пожалуйста, необходим макрос, который искал бы в строках (их более 1 млн) цифровые значения (например, 30000 руб, 30000 руб.,зарплата 30 т.р.,30 тыс руб,30000 рублей,зарплата 30 тыс.руб.+ пенсия 5000 рублей
) и копировал только цифровые значения в соседнюю ячейку. Я макросам только начинаю учиться, поэтому даже представить не могу с чего начать.
Буду очень благодарен за помощь

Ответить

Michael_S

Дата: Пятница, 08.02.2013, 17:36 | Сообщение № 2

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

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

Сообщений: 2012

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

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

Excel2016

Леха1982, рисуйте свой файл-пример: какие строки, какие числа, где находятся, куда выложить... тогда можно на что-то рассчитывать.

Ответить

Леха1982

Дата: Пятница, 08.02.2013, 18:14 | Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

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

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

выкладываю пример
то есть макрос должен искать в столбце А цифровое значение, и копирует его(только цифровое значение) в столбец В

спасибо

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

Ответить

AlexM

Дата: Пятница, 08.02.2013, 18:40 | Сообщение № 4

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

Ранг: Участник клуба

Сообщений: 4517

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

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

Excel 2003

А что делать с ячейкой А7?
В В7 должно быть 35000?

Номер мобильного модема (без голосовой связи)
9269171249 МегаФон, Московский регион.

Ответить

Леха1982

Дата: Пятница, 08.02.2013, 18:55 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

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

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

35000 это самый лучший вариант, но устроит и разбить на 2 суммы в разные ячейки

Ответить

AlexM

Дата: Пятница, 08.02.2013, 20:45 | Сообщение № 6

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

Ранг: Участник клуба

Сообщений: 4517

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

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

Excel 2003

Решение макросом с использованием регулярных выражений.
[vba]

Код

Sub Macros()
Dim Arr
  Set myRange = Worksheets(1).Range("A1").CurrentRegion
  Arr = myRange.Value
  For i = 2 To UBound(Arr)
     stroka = Replace(Arr(i, 1), " т.р", "000")
     stroka = Replace(stroka, " тыс.руб", "000")
     stroka = Replace(stroka, " тыс руб", "000")
     stroka = Replace(stroka, " рублей", "")
     stroka = Replace(stroka, " руб", "")
     Set objRegExp = CreateObject("VBScript.RegExp")
     objRegExp.Pattern = "[^0-9,+]+"
     While objRegExp.Test(stroka)
         stroka = objRegExp.Replace(stroka, "")
     Wend
     Arr(i, 2) = Evaluate(stroka)
  Next i
Worksheets(1).Range("A1").Resize(i - 1, 2) = Arr
End Sub

[/vba]