Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование адреса из текста - Страница 3 - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 3 из 3«123
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование адреса из текста (Макросы/Sub)
Копирование адреса из текста
StoTisteg Дата: Воскресенье, 20.03.2016, 14:46 | Сообщение № 41
Группа: Авторы
Ранг: Ветеран
Сообщений: 541
Репутация: 45 ±
Замечаний: 0% ±

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


Проверь всё. ThisWorkbook.Save. On Error Resume Next.
 
Ответить
СообщениеВероятно тем, что это всего лишь тестовые примеры, а как это будет работать на реальной базе, не знает даже сам Василич по той простой причине, что не видел реальных баз.

Автор - StoTisteg
Дата добавления - 20.03.2016 в 14:46
Wasilich Дата: Воскресенье, 20.03.2016, 17:43 | Сообщение № 42
Группа: Друзья
Ранг: Ветеран
Сообщений: 866
Репутация: 221 ±
Замечаний: 0% ±

2003
на реальной базе, не знает даже сам Василич
Если в 31-м сообщении это реальная база %), то там же "чёрт ноги поломает". Не, я так не гуляюсь. :D
Вот чуть доработал и на этом... - пожалуйста.
[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
 
Ответить
Сообщение
на реальной базе, не знает даже сам Василич
Если в 31-м сообщении это реальная база %), то там же "чёрт ноги поломает". Не, я так не гуляюсь. :D
Вот чуть доработал и на этом... - пожалуйста.
[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:43
emkub Дата: Воскресенье, 20.03.2016, 17:50 | Сообщение № 43
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

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


Сообщение отредактировал emkub - Воскресенье, 20.03.2016, 18:02
 
Ответить
СообщениеОтпишусь после полной проверки.
Сначала не увидел, что появилась третья страница форума с дополненным макросом. Но что-то мне подсказывает, что изначально невыполнимая задача стала вполне выполнимой!

Автор - emkub
Дата добавления - 20.03.2016 в 17:50
emkub Дата: Понедельник, 21.03.2016, 01:06 | Сообщение № 44
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - emkub
Дата добавления - 21.03.2016 в 01:06
emkub Дата: Вторник, 22.03.2016, 10:16 | Сообщение № 45
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 0 ±
Замечаний: 0% ±

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

Автор - emkub
Дата добавления - 22.03.2016 в 10:16
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование адреса из текста (Макросы/Sub)
Страница 3 из 3«123
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!