Как найти значение одного столбца в другом и изменить цвет?

Question

Я новичок в Excel Macro VBA, поэтому, пожалуйста, несите меня.

У меня есть файл Excel настроить так:

Col1 Col2 
---- ---- 
a  a 
b  c 
c  e 
d  g 
e  i 
f 
g 
h 
i 
j 

Я хочу написать функцию VBA макрос, который будет находить значения, присутствующие в Col2, в Col1, и если он будет найден, то он будет установлен шрифт цвет ячейки на красный, в Col1 ..

Таким образом, для примера данных выше, значения a, c, e, g, i в Col1 следует обратиться к red цвет.

Для приведенного выше примера, давайте предположим, что Col1 значения от A3:A13 и Col2 от B3:B13 ..

Я использую Excel 2010 ..

Как я могу сделать это в Excel VBA макросов ?

Answer 1

Я делаю это розовый .. Ячейка A1: A10 .. Ячейка B1: B5 ..

Sub Test() 
Dim x1, x2 As Integer 

For x2 = 1 To 5 
    For x1 = 1 To 10 
    If Range("A" & Format(x1)).Value = Range("B" & Format(x2)).Value Then   
     Range("A" & Format(x1)).Font.Color = vbRed 
    End If 
    Next 
Next 
End Sub 

Answer 2

Я хотел проверить мои навыки немного с этим, несмотря на то, @matzone дал точный ответ уже. Я сделал этот Sub, который делает то же самое, но использует объекты Range и метод .Find(). С комментариями ...

Private Sub Test() 
    FindAndColorMatchesOfTwoColumns "A", "B" 
End Sub 

Private Sub FindAndColorMatchesOfTwoColumns(colTarget As String, colList As String) 
    Dim rLookUp As Range  ' Column range for list compared against 
    Dim rSearchList As Range ' Column range for compare items 
    Dim rMatch As Range 
    Dim sAddress As String 

    ' Set compared against list from colTarget column 
    Set rLookUp = Range(colTarget & "1:" & _ 
        colTarget & Range(colTarget & "1").End(xlDown).Row) 

    ' Loop trough list from colList column 
    For Each rSearchList In Range(colList & "1:" & colList & Range(colList & "1").End(xlDown).Row) 

     ' Find for a match 
     Set rMatch = rLookUp.Find(rSearchList.Value, LookAt:=xlWhole) 
     If Not rMatch Is Nothing Then 
      ' Store first address found 
      sAddress = rMatch.Address 

      ' Loop trough all matches using .FindNext, 
      ' exit if found nothing or address is first found 
      Do 
       ' Set the color 
       rMatch.Font.Color = vbRed 

       Set rMatch = rLookUp.FindNext(rMatch) 

      Loop While Not rMatch Is Nothing And rMatch.Address <> sAddress 
     End If 
    Next 

    Set rMatch = Nothing 
    Set rSearchList = Nothing 
    Set rLookUp = Nothing 
End Sub 

Идея заключается в том, чтобы быть более динамичными, принять два столбца в качестве аргументов, установить поиск не колеблется до Range.End(xlDown).Row и не фиксируются на счет. Также допускается совпадение петли.

Для оригинального вопроса простые вложенные циклы проще, но использование .Find() оказалось бы намного быстрее, если количество столбцов увеличилось бы до тысячи (ей).

Испытано на «длинный список» гипотезы с этим тестом подразделам:

Private Sub RunTest() 
    Dim tStart As Date 
    Dim tEnd As Date 

    tStart = Timer 
    FindAndColorMatchesOfTwoColumns "A", "B" 
    tEnd = Timer 

    Debug.Print Format(tEnd - tStart, "0.000") 


    tStart = Timer 
    Test 
    tEnd = Timer 

    Debug.Print Format(tEnd - tStart, "0.000") 
End Sub 

Добавлено 1500 строк в колонке А и 184 строк в столбце В и получили Немедленное результат вид как:

0,266 
12,719 

Таким образом, действительно существует огромная разница в производительности ... Если ОП был только упрощенным примером для вопроса и намерен использовать это в больших наборах данных.

Answer 3

Простым несколько строк макроса будет решить эту проблему, как в:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 
Dim i As Integer, j As Integer 
For j = 1 To Cells(1, 2).End(xlDown).Row 
    For i = 1 To Cells(1, 1).End(xlDown).Row 
     If Cells(j, 2) = Cells(i, 1) Then 
     Cells(i, 1).Font.ColorIndex = 3 
     End If 
    Next 
Next 
End Sub 

Answer 4

Вот еще один вариант. Это может быть не очень красиво, но просто показывает, как много разных способов достижения такого же решения.

Sub updateFontColour() 

Dim rngCol1 As Range 
Dim rngCol2 As Range 
Dim myvalue As Long 
Dim c As Range 

'Set the ranges of columns 1 and 2. These are dynamic but could be hard coded 
Set rngCol1 = ThisWorkbook.Sheets("Sheet1").Range("A3:A" & Range("A" & Rows.Count).End(xlUp).Row) 
Set rngCol2 = ThisWorkbook.Sheets("Sheet1").Range("B3:B" & Range("B" & Rows.Count).End(xlUp).Row) 

'Loop through range 1 (column A) and use the 'Match' function to find a match in range 2 (column B) 
For Each c In rngCol1 
    On Error Resume Next 
    'I use the error handler as the match function returns a relative position and not an absolute one. 
    If IsError(myvalue = WorksheetFunction.Match(c.Value, rngCol2, 0)) Then 
     'Do noting, just move next 
    Else 
     c.Font.Color = vbRed 
    End If 

Next 

End Sub