2013-10-08 6 views
1

Я хочу запустить макрос на выбранных ячейках - где макрос сравнивает ячейку соседей ниже него - меняет цвет и переходит к следующей паре ячеек.работает макрос excel, который сравнивает выбранные ячейки

это 1 одномерный массив, где я хочу, чтобы сравнить каждую пару клеток (1-с 2-го, 3-й с 4-го и т.д.)

Я попытался работы с

For Each cell In Selection 

, но потом я дон Не знаю, как сравнить данную ячейку с той, которая находится под ней.

ответ

0

Ниже приведен пример кода.

Sub compare() 

    Dim rng As Range, cell As Range 
    Set rng = Selection ' 

    For Each cell In rng 
     'makes comparison 
     'offset(1,0) is used to find one cell below active cell 
     If cell.Value = cell.Offset(1, 0) Then 
      cell.Offset(1, 0).Interior.Color = vbRed 
     End If 
    Next 
End Sub 

Обновленный ответ

Sub compare() 

    Dim rows As Long 
    rows = Selection.rows.Count - 1 

    Dim selCol As Long 
    selCol = ActiveCell.Column 

    Dim selRow As Long 
    selRow = ActiveCell.Row 

    For i = selRow To (selRow + rows) 
     If Cells(i, selCol) = Cells(i, selCol + 1) Then 
      Range(Cells(i, selCol), Cells(i, selCol + 1)).Interior.Color = vbYellow 
     End If 
    Next 


End Sub 
+0

спасибо, но это сравнивает каждую клетку с одной под ним. я хотел проверить 2 пары за раз, а затем перейти к следующей паре. Я добавил условие, соответствующее моей потребности, но если вы можете объяснить, как это сделать, это может помочь другим людям. –

+0

мой код - попарное сравнение. вы можете взглянуть – sam092

0
Sub compareCells() 
    Dim i As Integer 
    'Check dimension 
    If Selection.Columns.Count <> 1 Then 
     MsgBox "not 1d array" 
     Exit Sub 
    End If 
    'Check size 
    If Selection.Rows.Count Mod 2 <> 0 Then 
     MsgBox "size not even" 
     Exit Sub 
    End If 
    For i = 1 To Selection.Count/2 
     With Selection 
     If .Cells(2 * i - 1) = .Cells(2 * i) Then 
      'what you want to do here, for e.g. , change color 
      .Cells(2 * i).Interior.Color = vbYellow 
     Else 
      'what you want to do here 
      'MsgBox "neq" 
     End If 
     End With 
    Next i 
End Sub 
Смежные вопросы