Страницы: 1
RSS
Замена значений согласно таблицы соответствий
 
Добрый вечер, планетяне!  
 
Прошу помощи в решении нижеприведенной проблемы.  
 
Есть перечень значений. Есть таблица соответствия "один-к-многим". Необходимо провести замену значений в соответствии с этой таблицей.  
 
Пока делаю это вручную с помощью Ctl-F, очень неудобно и периодически ошибаюсь от непрерывного "перескакивания" c места на место. Возможно ли это как-то автоматизировать?
 
Макросом сделать просто - но не понятно, что нужно.
 
Старался объяснить максимально понятно. Не получилось((  
 
Столбец А - исходные данные. Сверяем значение из ячейки А1 со значениями в диапазоне F1:I11. Если А1 равно одному из значений в диапазоне F1:I11, то А1 меняем на значение из E1:E11, если не равно, оставляем прежним.  
Пример из файла:  
А6 = F8 , А6 меняем на Е8  
А27 = Н7 , А27 меняем на Е7  
А28 = I7 , А28 меняем на Е7  
А2 = F1 , А2 меняем на Е1  
 
столбец В сделал только как демонстрацию конечного результата. Нужно менять значения в столбце А.  
 
Надеюсь, что смог объяснить понятнее.
 
Если 50 000 строк, то лучше взять диапазон столбца А в массив, цикл по массиву - Find по столбцу F (если таблица маленькая), если совпадает - меняем значение в массиве (Offset(0,-1). Затем массив на лист.  
Но, учитывая то, что здесь Игорь - возможен вариант со словарём :-)
 
Теперь понятно.
 
Я на словарь и нацелился - быстренько заполняем словарь из  F1:I11 - каждому значению в Item E1:E11/  
Затем одним проходом по A:A выгружаем эти запомненные значения.  
Счас...
 
Юрий М ваше объяснение мне, в теории, понятно. Но как перехожу к практике, "буксую" на элементарных (для вас) местах. Надеюсь, что Игорь предложит готовое решение. Это эгоистично, каюсь.
 
Option Explicit  
 
Sub tt()  
   Dim a(), b(), i&, ii&, t  
   a = [e1].CurrentRegion.Value
   b = [a1].CurrentRegion.Columns(1).Value
   With CreateObject("scripting.dictionary")  
       For i = 1 To UBound(a, 1)  
           For ii = 2 To UBound(a, 2)  
               If Len(a(i, ii)) Then .Item(a(i, ii)) = a(i, 1)  
           Next  
       Next  
 
       For i = 1 To UBound(b, 1)  
           t = b(i, 1)  
           If .exists(t) Then b(i, 1) = .Item(t)  
       Next  
   End With  
   [a1].CurrentRegion.Columns(1).Value = b
 
End Sub  
 
 
У Вас там нужно разобраться с    
5280 5888  
4901 5280  
 
Т.к. внизу результаты разные - слева моё, справа Ваше:  
4901 4901  
5280 4901  
4901 4901  
4901 4901  
4901 4901  
5280 4901  
4901 4901
 
"У Вас там нужно разобраться с    
5280 5888  
4901 5280"  
 
действительно косяк. Спасибо за подсказку.  
 
Начну тестировать Ваш макрос, потом отпишусь о результате.  
 
Спасибо за помощь.
 
Все работает.  
 
Огромное спасибо!!!
 
Ну и формула конечно:  
 
=ЕСЛИ(СЧЁТЕСЛИ($F$1:$I$11;A1)>0;ИНДЕКС($E$1:$E$11;МАКС(ЕЧИСЛО(ПОИСК(A1;$F$1:$I$11))*СТРОКА($E$1:$E$11)));A1)
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Владимир, спасибо, формула отлично работает. Правда на большом файле немного притормаживает. Пока пользуюсь макросом.
Страницы: 1
Наверх