Инструмент сравнения 2-массивов в Excel

[Avsha]

Добрый день!
Очень часто пользуюсь операцией сравнения двух массивов на соответствие элементов.
Идея какая,
1. выделяем 1 столбик ячеек - нажимаем кнопку 1 - это массив mas1,
2. выделяем 2 столбик ячеек - нажимаем кнопку 2 - это массив mas2,
3. нажимаем кнопку 3 - происходит сравнение элементов mas1 и mas2, и если нет отличий - то выдается сообщение Ok, если есть отличие, выделяем ячейку 1-го несоответствия.

Действия 1 и 2 реализуются следующим образом

Код: Выделить всё

Sub Макрос_mas1()   
    ActiveWorkbook.Names.Add Name:="mas1", RefersToR1C1:=Selection
End Sub

Sub Макрос_mas2()   
    ActiveWorkbook.Names.Add Name:="mas2", RefersToR1C1:=Selection
End Sub

Помоготе реализовать действие 3.
Или у кого есть другие варианты решения этой задачи?

[treider]

Можно просто сравнить два диапазона

Код: Выделить всё

Dim R1 As Range
Dim R2 As Range
 
Private Sub CommandButton1_Click()
Set R1 = Selection
End Sub
Private Sub CommandButton2_Click()
Set R2 = Selection
End Sub
Sub d3()
 r = R1.Rows.Count
 c = R1.Columns.Count
 For a = 1 To r
  For b = 1 To c
   If R1.Cells(a, b).Value <> R2.Cells(a, b).Value Then
    R1.Cells(a, b).Select
    Exit Sub
   End If
  Next
 Next
End Sub

[Avsha]

Спасибо treider,

немного подредактировал ваш вариант, расположив макросы в PERSONAL.XLS и привязал их к кнопкам панели инструментов:

Модуль "Mod_Ravno"

Код: Выделить всё

Dim R1 As Range
Dim R2 As Range

Sub mas1()
    Set Mod_Ravno.R1 = Selection
    ActiveWorkbook.Names.Add Name:="mas1", RefersToR1C1:=Selection
End Sub

Sub mas2()
    Set Mod_Ravno.R2 = Selection
    ActiveWorkbook.Names.Add Name:="mas2", RefersToR1C1:=Selection
End Sub

Sub Ravno()
 r = Mod_Ravno.R1.Rows.Count
 c = Mod_Ravno.R1.Columns.Count
 For a = 1 To r
  For b = 1 To c
   If Mod_Ravno.R1.Cells(a, b).Value <> Mod_Ravno.R2.Cells(a, b).Value Then
    Mod_Ravno.R1.Cells(a, b).Select
    Exit Sub
   End If
  Next
 Next
 MsgBox "Сравнение завершено успешно !"
End Sub

[Naeel Maqsudov]

Нет предела свершенству!
Замените 3 действия одним!

Код: Выделить всё

Sub Ravno()
  Dim R1 As Range, R2 As Range, c As Range, DiffAddr As String
  DiffAddr = ""
  With Selection.Areas
    If .Count = 2 Then
      Set R1 = .Item(1)
      Set R2 = .Item(2)
      If R1.Rows.Count = R2.Rows.Count And _
      R1.Columns.Count = R2.Columns.Count Then
        For Each c In R2
          If c.Value <> Cells(c.Row - R2.Row + R1.Row, c.Column - R2.Column + R1.Column).Value Then
            DiffAddr = DiffAddr & "," & c.Address(False, False)
          End If
        Next
        DiffAddr = Mid(DiffAddr, 2)
        If DiffAddr = "" Then
          MsgBox "These ranges are equals. Congratulations!!!"
        Else
          Range(DiffAddr).Select
          MsgBox Selection.Cells.Count & " wrong cell(s) was found."
        End If
      Else
        MsgBox "These ranges are not equals because its size is different."
      End If
    Else
      MsgBox "Select exactly TWO ranges, please."
    End If
 End With
End Sub

Теперь надо выделить один (эталоный) массив, затем с клавишей Ctrl второй (порядок выделения важен!), в котором ищутся отличия и запустить макрос. Он найдет и выделит ВСЕ отличия.

PS
Поясню прелесть выделения нескольких ячеек:
Выделенные ячейки можно редактировать "прыгая" по ним клавишей Enter. Главное - это не нажимать стрелок.

[Avsha]

Naeel Maqsudov,

Спасибо за вариант,
я тоже думал, как нормальный (или ненормальный) максималист о выделении обоих диапазонов за раз.

Но есть ограничение при этом способе выбора, оно следущее:
Если выбирать один диапазон с помощью клавиатуры, например длинный столбец длиной под 1000 ячеек,
то я использую удобное сочтание Shift-Ctrl-стрелка вниз, - выделяется столбец до "упора" - последнего значения.
Но выделить одновременно два таких столбца - удобным способом у меня не очень получается.

Хотя для небольших диапазонов - ваш вариант несомненно выигрывает по лаконичности.

[Naeel Maqsudov]

Коллега, разработчики позаботились обо всем.
Выделите один, затем нажмите Shift+F8 и выделите другой, затем опять Shift+F8, и третий....
Никакой мыши!

[Avsha]

Спасибо, ну вот вроде "добили" тему

[Avsha]

Нет предела свершенству!

Теперь диапазоны самовыделяются:

Sub mas1()
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Set Mod_Ravno.R1 = Selection
ActiveWorkbook.Names.Add Name:="mas1", RefersToR1C1:=Selection
End Sub

Sub mas2()
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Set Mod_Ravno.R2 = Selection
ActiveWorkbook.Names.Add Name:="mas2", RefersToR1C1:=Selection
End Sub