Страницы: 1
RSS
VBA - замена значений в ячейках только в выделенном диапазоне по условию
 
Добрый день знатоки!
помогите, пожалуйста.

Нужно найти и заменить значения только в выделенном диапазоне (не по всему листу) по условию.
Например есть исходные данные плоского вида:
ТоварДатаПримечаниеКоличество
Капуста18.07.2019Спеццена32
Морковь18.07.2019No85
Яблоко18.07.2019Спеццена16
Картошка18.07.2019No94
Лук18.07.2019No15
Капуста19.07.2019No88
Морковь19.07.2019No75
Яблоко19.07.2019No46
Картошка19.07.2019No0
Исходные данные, подтягиваются автоматом. Значение No-по умолчанию. За Предыдущие даты уже были (полуруками) проставлено примечание Спеццена и его трогать нельзя.
так же есть на соседнем листе список этих самых спец.цен с товарами, которое тянется из другого места.
ТоварПримечание
МорковьСпеццена
КартошкаСпеццена
нужно макросом обработать так, чтобы в выделенном мной диапазоне за 19 число Примечание No заменилось на Спеццена, если товар есть в списке на соседнем листе.

у меня получилось только тупо обрабатывать и заменять все имеющиеся данные в листе, а так нельзя.
заранее спасибо за ПОМОЩЬ!
 
Цитата
Wendflower написал:
у меня получилось только
если у Вас получилось на весь лист, то не понимаю, что останавливает сделать то же самое для отмеченного диапазона???
если получилось не у Вас, то так и пишите: нашел вот такой макрос помогите исправить его чтобы он работал для вот таких условий
и найдется кто-то, кто поможет
а пока сообщение читается так:
"я для листа сделал, но парится еще и с диапазоном - облом. сделайте кто-нибудь чтобы работало в отмеченном диапазоне, пожалуйста!"
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Wendflower, можно так
Код
Sub csg()
Dim iCell As Range
Dim lr As Long, i As Long
Application.ScreenUpdating = False
With Selection
        If .Column <> 1 Then Exit Sub
        If .Columns.Count > 1 Then Exit Sub
End With
lr = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
   For Each iCell In Selection
      For i = 2 To lr
         If iCell = Sheets(2).Cells(i, 1) Then
           iCell.Offset(0, 2) = Sheets(2).Cells(i, 2)
         End If
       Next
    Next
Application.ScreenUpdating = True
End Sub
Изменено: casag - 20.07.2019 08:07:49
 
casag,спасибо!!!!!!
 
casag, For Each iCell In Selection - перебор всех ячеек выделенного диапазона. А это подразумевает намного больше вычислений в циклах:
к-во_столбцов_диапазона*к-во_значений_листа2

Немного изменил:
Код
Sub csg()
    Dim rRng As Range
    Dim lRw As Long, i As Long, k As Long
    
    With Selection
        If .Column <> 1 Then Exit Sub
        If .Columns.Count < 3 Then Exit Sub
    End With
    
    Set rRng = Selection
    lRw = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
 
    With Sheets(2)
        For k = 1 To rRng.Rows.Count
           For i = 2 To lRw
              If rRng(k, 1).Value = .Cells(i, 1).Value Then rRng(k, 3).Value = "Спеццена"
            Next i
         Next k
    End With
   
    Application.ScreenUpdating = True
    Set rRng = Nothing
End Sub

Если диапазон большой, лучше обработать в массиве.
 
vikttur, Спасибо за разъяснения, буду иметь в виду. Я только учусь, поэтому здоровая критика приветствуется. Всех благ.
Добавил в свой макрос ограничение.
Код
With Selection
        If .Column <> 1 Then Exit Sub
        If .Columns.Count > 1 Then Exit Sub
End With
Изменено: casag - 20.07.2019 08:06:14
Страницы: 1
Наверх