Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Пакетная замена в Excel нестандартным методом
 
Всем доброго дня.
Столкнулся с такой проблемой.
Часто приходится делать массовые замены в Excel файлах больших объемов.
Для этого есть много тем и отличные макросы. которые это грамотно делают,
Сделал и свой макрос, который в т.ч первоначально прописывает пробелы впереди и сзади как в самих данных, так и в таблице соответствия. чтобы менялись только целые слова.
Но все они используют функцию Replace и метод перебора.
если объемы небольшие, этого вполне хватает.
Но бывают так, что сами данные составляют несколько десятков, а то и сотен тысяч строк, да и таблица соответствий - несколько тысяч.
В этом случае замена может занимать более часа времени.

Поэтому вопрос:
Можно ли сделать макрос, который пакетно будет менять данные.
и если можно прошу пример такого макроса.
С уважением.
Изменено: Sobes - 1 Мар 2017 10:11:55
 
Добрый день.
Попробуйте такой код для данных на Листе1
Код
Sub Main()
  Dim a(), b, i&, r&, s$
  Dim Rng As Range
  Set Rng = ActiveSheet.Cells(1).CurrentRegion.Columns(1)
  a() = Sheets("Соответствия").Cells(1).CurrentRegion.Columns(1).Resize(, 2).Value
  With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For r = 2 To UBound(a)
      s = Trim(a(r, 1))
      If Len(s) Then .Item(s) = a(r, 2)
    Next
    a() = Rng.Value
    For r = 1 To UBound(a)
      s = Trim(a(r, 1))
      If Len(s) Then
        b = Split(s)
        For i = 0 To UBound(b)
          If .Exists(b(i)) Then b(i) = .Item(b(i))
        Next
        a(r, 1) = Join(b)
      End If
    Next
  End With
  With Rng.Offset(, 1)
    .Value = a()
    .Columns.AutoFit
  End With
End Sub
Vladimir Zakharov
Microsoft MVP – Excel
 
Спасибо огромное!
Страницы: 1
Читают тему (гостей: 1)