Копирование адреса из текста - Страница 3

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование адреса из текста (Макросы/Sub)

Копирование адреса из текста

StoTisteg

Дата: Воскресенье, 20.03.2016, 14:46 | Сообщение № 41

Группа: Авторы

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

Сообщений: 1161

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

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

Excel 2010

Вероятно тем, что это всего лишь тестовые примеры, а как это будет работать на реальной базе, не знает даже сам Василич по той простой причине, что не видел реальных баз.

Интуитивно понятный код - это когда интуитивно понятно, что это код.

Ответить

Wasilich

Дата: Воскресенье, 20.03.2016, 17:43 | Сообщение № 42

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

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

Сообщений: 1232

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

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

2003

Цитата StoTisteg, 20.03.2016 в 14:46, в сообщении № 41

на реальной базе, не знает даже сам Василич

Если в 31-м сообщении это реальная база %), то там же "чёрт ноги поломает". Не, я так не гуляюсь.

Вот чуть доработал и на этом... - пожалуйста.
[vba]

Код

Sub tekst()
  For i = 1 To Range("K" & Rows.Count).End(xlUp).Row '№ последней строки
    ul = Cells(i, 11) 'название улицы
    If ul <> "" Then 'если улица не пусто
       st = Cells(i, 12) & " " & Cells(i, 13)
       st = Replace(st, ",", " ") 'текст в переменную без запятых
       st = Replace(st, ".", " ") 'текст в переменную без точек
       st = Replace(st, "ул", " ") 'текст в переменную без "ул"
       st = Application.Trim(st) & " " 'сжимаем пробелы и добавляем один в конец
       ns = InStr(st, ul) + Len(ul) + 1 'определяем № символа в строке после улицы
       sd = Mid(st, ns) 'берем часть строки после улицы
       If IsNumeric(Mid(sd, 1, 1)) = True Then 'если число после улицы
          KS = InStr(sd, " ") 'определяем № пробела в части строки
          ND = Mid(sd, 1, KS) 'выбираем символы из части строки до пробела
          Cells(i, 11) = Cells(i, 11) & " " & ND 'дописываем № дома к улице
       End If
    End If
  Next
End Sub

[/vba]

Сообщение отредактировал Wasilich - Воскресенье, 20.03.2016, 17:45

Ответить

emkub

Дата: Воскресенье, 20.03.2016, 17:50 | Сообщение № 43

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

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

Сообщений: 171

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

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

Excel 2013

Отпишусь после полной проверки.
Сначала не увидел, что появилась третья страница форума с дополненным макросом. Но что-то мне подсказывает, что изначально невыполнимая задача стала вполне выполнимой!

Сообщение отредактировал emkub - Воскресенье, 20.03.2016, 18:02

Ответить

emkub

Дата: Понедельник, 21.03.2016, 01:06 | Сообщение № 44

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

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

Сообщений: 171

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

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

Excel 2013

Прогнал один файлик на 600 строк. Результат впечатляет! Точность работы макроса 90-95%.
Наверное завтра отпишусь подробнее.

Ответить

emkub

Дата: Вторник, 22.03.2016, 10:16 | Сообщение № 45

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

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

Сообщений: 171

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

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

Excel 2013

Что же, теперь могу отписаться о этом проекте.
В целом макрос работает почти идеально. Как и предполагалось, ошибка захвата этажа через "/" осталась (5/9). Думаю, это я смогу исправить даже красивее, чем описывал ранее, точность будет выше, если добавить проверку сравнения "а" и "б" в "а/б". В этажности "б" всегда больше; в нумерации домов "б" почти всегда меньше.
Есть ещё парочка совсем мелочей, но то уже несущественно.
ВСЕМ ОГРОМНОЕ СПАСИБО, в особенности ВАСИЛИЧУ! ВЫ СДЕЛАЛИ НЕВОЗМОЖНОЕ! hands

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование адреса из текста (Макросы/Sub)

Страница 3 из 3
«
1
2
3