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

Вход

Регистрация

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

 

= Мир MS Excel/Замена одних значений (много!) на другие по списку. - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена одних значений (много!) на другие по списку. (Макросы/Sub)
Замена одних значений (много!) на другие по списку.
Serge1400 Дата: Понедельник, 03.07.2017, 00:37 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Всем доброй ночи!
Есть у меня в трудовой деятельности одна очень нудная процедура:
приходят запросы на товары из разных стран. И вот эти страны клиенты почти в 90% пишут одним словом и на русском языке, хотя должны в международном варианте: то есть Китай - СN, Турция -TR и т.п. И приходится все это вручную переименовывать. А запросы частенько по 500 позиций и более имеют.
Пошарил я в интернете и нашел пару вариантов: но уж больно там хлопотно получается. Надо несколько раз произвести разные доп.действия: .
Хотелось бы что нибудь полаконичнее использовать:
Собственно пример прилагаю:
значения которые надо менять. всегда в одной и той же колонке находятся. Вносятся туда копированием из запросов. Список, из которого берутся данные для замены, по возможности хотелось бы иметь на том же листе.
Ну пример
К сообщению приложен файл: example1.xlsx (10.4 Kb)
 
Ответить
СообщениеВсем доброй ночи!
Есть у меня в трудовой деятельности одна очень нудная процедура:
приходят запросы на товары из разных стран. И вот эти страны клиенты почти в 90% пишут одним словом и на русском языке, хотя должны в международном варианте: то есть Китай - СN, Турция -TR и т.п. И приходится все это вручную переименовывать. А запросы частенько по 500 позиций и более имеют.
Пошарил я в интернете и нашел пару вариантов: но уж больно там хлопотно получается. Надо несколько раз произвести разные доп.действия: .
Хотелось бы что нибудь полаконичнее использовать:
Собственно пример прилагаю:
значения которые надо менять. всегда в одной и той же колонке находятся. Вносятся туда копированием из запросов. Список, из которого берутся данные для замены, по возможности хотелось бы иметь на том же листе.
Ну пример

Автор - Serge1400
Дата добавления - 03.07.2017 в 00:37
_Boroda_ Дата: Понедельник, 03.07.2017, 02:20 | Сообщение № 2
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Далеко не самый быстрый способ, но так специально написал для понятности
[vba]
Код
Sub ZamStran()
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    r0_ = 2
    r00_ = 2
    c0_ = 1
    c00_ = 7
    r1_ = Cells(Rows.Count, c0_).End(3).Row
    r11_ = Cells(Rows.Count, c00_).End(3).Row
    On Error GoTo A
    ar1 = Cells(r0_, c0_).Resize(r1_ - r0_ + 1)
    ar11 = Cells(r00_, c00_).Resize(r11_ - r00_ + 1, 2)
    n1_ = UBound(ar1)
    n11_ = UBound(ar11)
    For i = 1 To n1_
        For j = 1 To n11_
            If LCase(ar1(i, 1)) = LCase(ar11(j, 1)) Then
                ar1(i, 1) = ar11(j, 2)
                Exit For
            End If
        Next j
    Next i
    Cells(r0_, c0_).Resize(r1_ - r0_ + 1) = ar1
A:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
End Sub
[/vba]
К сообщению приложен файл: example1_1.xlsm (20.0 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеДалеко не самый быстрый способ, но так специально написал для понятности
[vba]
Код
Sub ZamStran()
    Application.ScreenUpdating = 0
    Application.Calculation = xlCalculationManual
    r0_ = 2
    r00_ = 2
    c0_ = 1
    c00_ = 7
    r1_ = Cells(Rows.Count, c0_).End(3).Row
    r11_ = Cells(Rows.Count, c00_).End(3).Row
    On Error GoTo A
    ar1 = Cells(r0_, c0_).Resize(r1_ - r0_ + 1)
    ar11 = Cells(r00_, c00_).Resize(r11_ - r00_ + 1, 2)
    n1_ = UBound(ar1)
    n11_ = UBound(ar11)
    For i = 1 To n1_
        For j = 1 To n11_
            If LCase(ar1(i, 1)) = LCase(ar11(j, 1)) Then
                ar1(i, 1) = ar11(j, 2)
                Exit For
            End If
        Next j
    Next i
    Cells(r0_, c0_).Resize(r1_ - r0_ + 1) = ar1
A:
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = 1
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 03.07.2017 в 02:20
InExSu Дата: Вторник, 04.07.2017, 09:51 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
[vba]
Код

Option Base 1
Sub Замена_от_InExSu()
    Dim мКлиенты(), мСправ()
    
    Range("a1").CurrentRegion.Select
    мКлиенты = Selection
    
    Range("g1").CurrentRegion.Select
    мСправ = Selection
    
    For i = 1 To UBound(мКлиенты)
        For j = 1 To UBound(мСправ)
            If мКлиенты(i, 1) = мСправ(j, 1) Then _
                мКлиенты(i, 1) = мСправ(j, 2)
        Next
    Next

    ActiveSheet.Range("a1").Resize(UBound(мКлиенты), UBound(мКлиенты, 2)) _
    = мКлиенты
End Sub
[/vba]


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac

Сообщение отредактировал InExSu - Вторник, 04.07.2017, 09:54
 
Ответить
Сообщение[vba]
Код

Option Base 1
Sub Замена_от_InExSu()
    Dim мКлиенты(), мСправ()
    
    Range("a1").CurrentRegion.Select
    мКлиенты = Selection
    
    Range("g1").CurrentRegion.Select
    мСправ = Selection
    
    For i = 1 To UBound(мКлиенты)
        For j = 1 To UBound(мСправ)
            If мКлиенты(i, 1) = мСправ(j, 1) Then _
                мКлиенты(i, 1) = мСправ(j, 2)
        Next
    Next

    ActiveSheet.Range("a1").Resize(UBound(мКлиенты), UBound(мКлиенты, 2)) _
    = мКлиенты
End Sub
[/vba]

Автор - InExSu
Дата добавления - 04.07.2017 в 09:51
Serge1400 Дата: Вторник, 04.07.2017, 10:00 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Саша, спасибо! То что надо
 
Ответить
СообщениеСаша, спасибо! То что надо

Автор - Serge1400
Дата добавления - 04.07.2017 в 10:00
Michael_S Дата: Вторник, 04.07.2017, 10:22 | Сообщение № 5
Группа: Друзья
Ранг: Старожил
Сообщений: 2012
Репутация: 373 ±
Замечаний: 0% ±

Excel2016
.End(3).Row

Саш, а откуда ты 3 взял?
в immediate возвращает
?xlup
-4162


Сообщение отредактировал Michael_S - Вторник, 04.07.2017, 10:22
 
Ответить
Сообщение
.End(3).Row

Саш, а откуда ты 3 взял?
в immediate возвращает
?xlup
-4162

Автор - Michael_S
Дата добавления - 04.07.2017 в 10:22
Kuzmich Дата: Вторник, 04.07.2017, 10:25 | Сообщение № 6
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 155 ±
Замечаний: 0% ±

Excel 2003
InExSu
Надо в код ввести LCase
[vba]
Код
Option Explicit

Option Base 1
Sub Замена_от_InExSu()
Dim мКлиенты(), мСправ()
Dim i As Long
Dim j As Long
    мКлиенты = Range("a1").CurrentRegion.Value
    мСправ = Range("g1").CurrentRegion.Value
    For i = 1 To UBound(мКлиенты)
        For j = 1 To UBound(мСправ)
            If LCase(мКлиенты(i, 1)) = LCase(мСправ(j, 1)) Then _
                мКлиенты(i, 1) = мСправ(j, 2)
        Next
    Next
    ActiveSheet.Range("a1").Resize(UBound(мКлиенты), UBound(мКлиенты, 2)) _
    = мКлиенты
End Sub
[/vba]
 
Ответить
СообщениеInExSu
Надо в код ввести LCase
[vba]
Код
Option Explicit

Option Base 1
Sub Замена_от_InExSu()
Dim мКлиенты(), мСправ()
Dim i As Long
Dim j As Long
    мКлиенты = Range("a1").CurrentRegion.Value
    мСправ = Range("g1").CurrentRegion.Value
    For i = 1 To UBound(мКлиенты)
        For j = 1 To UBound(мСправ)
            If LCase(мКлиенты(i, 1)) = LCase(мСправ(j, 1)) Then _
                мКлиенты(i, 1) = мСправ(j, 2)
        Next
    Next
    ActiveSheet.Range("a1").Resize(UBound(мКлиенты), UBound(мКлиенты, 2)) _
    = мКлиенты
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 04.07.2017 в 10:25
_Boroda_ Дата: Вторник, 04.07.2017, 11:01 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Да просто как-то надоело писать эти лефтовые дауны
Запустил в пошаговом режиме такой макросишко
[vba]
Код
For i = 1 To 4
    Range(Range("D4"), Range("D4").End(i)).Select
Next i
[/vba]
посмотрел на выделение, провел глубочайшие аналитические изыскания и пришел к выводу, что:
1 - влево
2 - вправо
3 - вверх
4 - вниз


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеДа просто как-то надоело писать эти лефтовые дауны
Запустил в пошаговом режиме такой макросишко
[vba]
Код
For i = 1 To 4
    Range(Range("D4"), Range("D4").End(i)).Select
Next i
[/vba]
посмотрел на выделение, провел глубочайшие аналитические изыскания и пришел к выводу, что:
1 - влево
2 - вправо
3 - вверх
4 - вниз

Автор - _Boroda_
Дата добавления - 04.07.2017 в 11:01
RAN Дата: Вторник, 04.07.2017, 20:31 | Сообщение № 8
Группа: Друзья
Ранг: Экселист
Сообщений: 5660
Репутация: 1163 ±
Замечаний: 0% ±

2010
откуда ты 3 взял?

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


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение
откуда ты 3 взял?

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

Автор - RAN
Дата добавления - 04.07.2017 в 20:31
alex77755 Дата: Вторник, 04.07.2017, 20:38 | Сообщение № 9
Группа: Проверенные
Ранг: Обитатель
Сообщений: 362
Репутация: 64 ±
Замечаний: 0% ±

если данных много, то лучше загнать сразу в словарь все замены и не гонять цикл в цикле


Могу помочь в VB6, VBA
Alex77755@mail.ru
 
Ответить
Сообщениеесли данных много, то лучше загнать сразу в словарь все замены и не гонять цикл в цикле

Автор - alex77755
Дата добавления - 04.07.2017 в 20:38
_Boroda_ Дата: Вторник, 04.07.2017, 22:28 | Сообщение № 10
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16666
Репутация: 6478 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
лучше загнать сразу в словарь все замены и не гонять цикл в цикле
Спасибо, я в курсе. Только Сергей, тот, который Serge1400, насколько я знаю, пытается изучать (или, по крайней мере, понять) макросы, но со словарями ему пока сложно. Поэтому я и написал
Далеко не самый быстрый способ, но так специально написал для понятности


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
Сообщение
лучше загнать сразу в словарь все замены и не гонять цикл в цикле
Спасибо, я в курсе. Только Сергей, тот, который Serge1400, насколько я знаю, пытается изучать (или, по крайней мере, понять) макросы, но со словарями ему пока сложно. Поэтому я и написал
Далеко не самый быстрый способ, но так специально написал для понятности

Автор - _Boroda_
Дата добавления - 04.07.2017 в 22:28
Serge1400 Дата: Среда, 05.07.2017, 10:06 | Сообщение № 11
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 101
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Только Сергей, тот, который Serge1400, насколько я знаю, пытается изучать (или, по крайней мере, понять) макросы, но со словарями ему пока сложно.

Да, именно так: написано для деревянных вроде меня.
Саша, спасибо! Но один хрен пока все равно малопонятно.
 
Ответить
Сообщение
Только Сергей, тот, который Serge1400, насколько я знаю, пытается изучать (или, по крайней мере, понять) макросы, но со словарями ему пока сложно.

Да, именно так: написано для деревянных вроде меня.
Саша, спасибо! Но один хрен пока все равно малопонятно.

Автор - Serge1400
Дата добавления - 05.07.2017 в 10:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Замена одних значений (много!) на другие по списку. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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