Страницы: 1
RSS
Макрос переноса значения из одной ячейки в другую по сравнению
 
Всем доброго дня суток!
Столкнулась с одной интересной задачей, целый день пытаюсь её решить, но никак не получается.
Есть две пары столбцов "Фамилия" и "Табельный номер". В первой паре данные столбца "Табельный номер" заполнены, во второй паре столбец "Табельный номер" пуст. Нужно написать макрос, который перенесёт значения ячеек в столбце "Табельный номер" во второй экземпляр при совпадении Фамилии.
Помогите пожалуйста, кто в этом разбирается)
Заранее выражаю огрооомную благодарность! ^^
 
Опять перенос? Точно нужно именно так, как это слово в словарях/википедиях толкуется?
 
И вам здоровьичка.
Зачем вам макрос, возьмите формулу:
Код
=ВПР(A2;$D$2:$E$5;2;ЛОЖЬ)

в В2 и вниз тянуть.
Кому решение нужно - тот пример и рисует.
 
Цитата
Пытливый написал: в В2 и вниз тянуть.
Она ж не перенесет, она скопирует. А здесь, как следует из задания, надо чтобы в первой таблице этот табельный номер убрался. Поскольку формула удалять не умеет, то здесь можно решить только макросом. Ну или вручную потом удалять.
Изменено: wowick - 20.03.2018 23:27:15
Если автоматизировать бардак, то получится автоматизированный бардак.
 
Да что ж такое сегодня, все не слава ТНБ! :)
Кому решение нужно - тот пример и рисует.
 
ВПР нельзя использовать. Требуется исключительно использование макроса(
 
Hugo,нужно, чтобы макрос, обнаружив совпадение Фамилий, перенёс значение табельного номера ко второй такой же Фамилии
Изменено: Logunas - 20.03.2018 16:54:12
 
Так если "скопировал" - берите предложенную ВПР(), в конце спецкопипастом замените формулу на значения. Запишите процесс рекордером - получите макрос!
 
Hugo,неправильно изъяснилась, пардон)
Перенести нужно, не иначе((
 
См.
 
Мотя,спасииибо, но это решение с помощью ВПР. А нужно через макрос(((
 
Цитата
Logunas написал:
ВПР нельзя использовать. Требуется исключительно использование макроса
Почему?!
Макрос, как правило: "программа на 1-ой ножке"!
 
Вы - студентка?  :)  
 
Цитата
Мотя написал:
Вы - студентка?  
уже нет, но недалеко ушла)))
 
Наверное, у Вас "тупой" начальник?!  :D  
 
Цитата
Мотя написал:
Почему?!Макрос, как правило: "программа на 1-ой ножке"
Условие такое поставлено - написать только через макрос((
Если бы можно было через ВПР, я бы наверное сюда и не обращалась, т.к. ВПР мне намного более роднее, чем макросы всякие(
 
Цитата
Logunas написал:
Условие такое поставлено - написать только через макрос
Тогда показывайте реальную структуру файла (файлов)!
 
Ну собственно это и есть реальная структура файла. Ничего больше нет.  
 
Вот макрос на условном форматировании. Можно на массивах, но писать дольше ;-)

PS Но он все равно использует ВПР

Код
Sub Перенос()

Dim rng1 As Range, rng2 As Range

Set rng1 = Range("b1:b5") ' Диапазон, куда вставлять значения
Set rng2 = Range("d1:e5") ' Диапазон, откуда брать значения

'На всякий случай в первом диапазоне выделяем только пустые ячейки
Set rng1 = rng1.SpecialCells(xlCellTypeBlanks)

' Получение табельных номеров в первую таблицу
rng1.FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-1]," & rng2.Address(1, 1, xlR1C1) & ",2,FALSE),"""")"
rng1.Formula = rng1.Value

' Помечаем дубликаты
With Union(rng1, rng2).Offset(1, 0)
.FormatConditions.Delete
.FormatConditions.AddUniqueValues
.FormatConditions(1).DupeUnique = xlDuplicate
.FormatConditions(1).Font.Color = -16383844
End With

' Фильтруем таблицу по цвету
If ActiveSheet.AutoFilterMode = False Then rng2.AutoFilter
rng2.AutoFilter Field:=2, Criteria1:=RGB(156, 0, 6), Operator:=xlFilterFontColor

' удаляем отфильтрованные значения
rng2.Resize(rng2.Rows.Count, 1).Offset(1, 1).SpecialCells(xlCellTypeVisible).Clear

' убираем автофильтр и условное форматирование
Union(rng1, rng2).Offset(1, 0).FormatConditions.Delete
rng2.AutoFilter

End Sub
Изменено: yaroslav.tikhonov - 20.03.2018 17:25:47
 
Код
Sub asd()
    f_sn = Range("A2:B5")
    s_sn = Range("D2:E5")
    
    For i = 1 To UBound(f_sn, 1)
        For j = 1 To UBound(s_sn, 1)
            If f_sn(i, 1) = s_sn(j, 1) Then
                f_sn(i, 2) = s_sn(j, 2)
                Exit For
            End If
        Next j
    Next i
    
    Cells(2, 1).Resize(UBound(f_sn, 1), UBound(f_sn, 2)) = f_sn
End Sub
 
yaroslav.tikhonov, kavaka, ОГРОМНОЕ ВАМ СПАСИБО, всё прекрасно работает!  :*  
 
Так я и не понял - нужно было копировать или переносить? :)
 
Переносить с:
 
Цитата
Мотя написал:
Макрос, как правило: "программа на 1-ой ножке"!
Начинается... ))
 
yaroslav.tikhonov, зачем при работе с VBA использовать условное форматирование?
 
Цитата
vikttur написал:
условное форматирование?
Там же есть ответ.
Цитата
yaroslav.tikhonov написал:
Можно на массивах, но писать дольше ;-)
По вопросам из тем форума, личку не читаю.
 
Красить можно и без массивов.
 
Цитата
vikttur написал:
Красить можно и без массивов.
Написал первым способом, который пришел на ум, согласен - на больших массивах может быть не оптимальным (хотя УФ + фильтр должны по идее шустро работать)
 
Цитата
Yaroslav_T написал:
(хотя УФ + фильтр должны по идее шустро работать)
Особенно на больших таблицах перенасыщенных формулами, ага)
Страницы: 1
Наверх