Страницы: 1
RSS
Поиск значения в одном столбце по данным с другого столбца с копированием адреса ячейки
 
Добрый день. Тока начинаю изучать VBA / Помогите пожалуйста. Есть всего 4 столбца. Есть 2 столбца с данными. Нужно последовательно перебирать данные из столбца 1 и искать совпадение в столбце 2. Данные в столбце 2 не повторяются.

Если данные в столбце 2 найдены то закрасить найденную ячейку в столбце 2 с совпадающим значением из столбца 1 желтым цветом. В столбец 3, рядом с текущей ячейкой,  записать "ОК". В столбец 4 записать адрес ячейки из столбца 2.

Если найденная ячейка в столбце 2 была уже закрашена желтым, то в столбце   3   написать " ОК – желтая", закрасить ячейку в столбце 3 желтым цветом  а в столбце 4 записать адрес ячейки
   
Если ячейка с совпадающим значением в столбце 2 не была найдена то в столбце   3   написать  не найдена и закрашивает ячейку  красным
цветом

 
Цитата
Oldman1977 написал:
Тока начинаю изучать VBA
ну а Ваши попытки решить задачу где? Или как Вы хотите начать изучать VBA?
Согласие есть продукт при полном непротивлении сторон
 
Код
Sub test()
    Dim c1 As Range
    Dim c2 As Range
    Dim found As Boolean
    For Each c1 In Range("F4:F8")
        found = False
        For Each c2 In Range("C4:C21")
            'Если данные в столбце 2 найдены то
            If c2.Value = c1.Value Then
                'Если найденная ячейка в столбце 2 была уже закрашена желтым, то в столбце   3   написать " ОК – желтая"
                If c1.Cells(1, 2).Interior.Color = RGB(255, 255, 0) Then
                    c1.Cells(1, 2).Value = "ОК – желтая"
                Else
                    'В столбец 3, рядом с текущей ячейкой,  записать "ОК".
                    c1.Cells(1, 2).Value = "ОК"
                End If
                'закрасить найденную ячейку в столбце 2 с совпадающим значением из столбца 1 желтым цветом.
                c1.Cells(1, 2).Interior.Color = c2.Interior.Color
                'В столбец 4 записать адрес ячейки из столбца 2.
                c1.Cells(1, 3).Value = c2.Address(0, 0)
                found = True
                Exit For
            End If
        Next
        'Если ячейка с совпадающим значением в столбце 2 не была найдена
        If Not found Then
            'то в столбце   3   написать  не найдена и закрашивает ячейку  красным цветом
            c1.Cells(1, 2).Value = "не найдена"
            c1.Cells(1, 2).Interior.Color = RGB(255, 0, 0)
        End If
    Next
End Sub
Код с учётом
Цитата
написал:
Тока начинаю изучать VBA
 
Oldman1977,
для старта Вам:
Код
Sub aaa()
rng1 = Range("F4:F8")
rng2 = Range("C4:C21")
For r1 = 1 To UBound(rng1)
    For r2 = 1 To UBound(rng2)
        If rng1(r1, 1) = rng2(r2, 1) Then
            Cells(r2 + 3, 3).Interior.Color = 65535
            Cells(r1 + 3, 7) = "ОК"
            Cells(r1 + 3, 8) = Cells(r2 + 3, 3).Address(RowAbsolute:=False, ColumnAbsolute:=False)
        End If
    Next r2
Next r1
End Sub
 
Еще вариант
 
спасибо буду тренироваться
Страницы: 1
Наверх