Сравнение 2 масивов excel

[Slavik]

Спасибо, но как можно вивести ето число в отдельную ячейку? (Мне оно нужно в последующих расчетах)

[Slavik]

Большое спасибо. А можно ли вивести ето число в отдельную ячейку? (мне оно нужно для последующих расчетов)

[Serge_Bliznykov]

а вот решение и через макросы... (Sasha_Smirnov, надеюсь, без обид?! )

В приложенном файлике пример.


А вот и исходный код:

  Dim nr As Integer, LastCol_1 As Integer
  Dim i As Integer, K As Integer
  nr = ActiveSheet.UsedRange.Columns.Count
  LastCol_1 = Cells(1, nr + 1).End(xlToLeft).Column
  
  ' полностью очистим 3-ю строчку (подготовим её к заполнению
  Rows("3:3").ClearContents
  
  K = 0
  For i = 1 To LastCol_1
    If Not IsEmpty(Cells(1, i)) Then
      If WorksheetFunction.CountIf(Range("2:2"), Cells(1, i)) = 0 Then
        K = K + 1
        Cells(3, K) = Cells(1, i)
      End If
    End If
  Next i

[Sasha_Smirnov]

Sub SeeTheDifference() 'печатает в строке 3 элементы строки 1, отсутствующие в строке 2'
'(столько раз, сколько в 1-й строке таких - не внесённых ни разу во 2-ю - элементов)'

Dim i_1 As Byte, j_2 As Byte 'переменные для индексации, от 0 до 255'
Dim pattern(), epigone() 'массивы для считывания чисел (и последующего сравнения)'
Dim NETiz1vo2 As Boolean

Range("A1").Select 'считываем (начиная с ячейки A1) 1-й массив'
If IsEmpty(ActiveCell) Then MsgBox "Ячейка A1 пуста.": Exit Sub
DataLoading pattern '"накачка" 1-го массива'

Range("A2").Select 'считываем (начиная с ячейки A2) 2-й массив'
If IsEmpty(ActiveCell) Then MsgBox "Ячейка A2 пуста.": Exit Sub
DataLoading epigone '"накачка" 2-го массива'

Range("A3").Select


For i_1 = 0 To UBound(pattern) 'перебор элементов 1-го массива'

NETiz1vo2 = True 'предполагаем, что очередного эл-та из 1-го массива во 2-м нет'

    For j_2 = 0 To UBound(epigone) 'перебор элементов 2-го массива'
        If epigone(j_2) = pattern(i_1) Then NETiz1vo2 = False: Exit For
        'выход - дальше сравнивать нет смысла: эл-т из pattern найден в epigone'
    Next j_2
    
    If NETiz1vo2 Then 'а так будет, если ни разу не сработала строка, где Exit For'    
    ActiveCell = pattern(i_1) 'печать не найденного во 2-м эл-та 1-го массива'    
    SendKeys "{right}", True
    End If
    
Next i_1
End Sub


Sub DataLoading(m())
Dim k As Byte

Do While Not IsEmpty(ActiveCell) 'пока в очередной ячейке не пусто'
    ReDim Preserve m(k) 'добавляем массиву размерность (до k), сохраняя данные'
    m(k) = ActiveCell
        If ActiveCell.Column = 256 Then Exit Do 'выход, если строка кончилась'
    SendKeys "{right}", True:    k = k + 1 'ползём по строке вправо'
Loop

'For k = 0 To UBound(m): MsgBox (m(k)): Next 'проверка того, как заполнился массив''
'(Кто не понял, здесь она отключена, но если снять левый "'", то будет работать.)'
End Sub

[Sasha_Smirnov]

Option Explicit
Dim DIRE As String

Sub SeeTheDifference() 'печатает (в Excel) такие элементы множества 1, каких нет во 2-м множестве'
Static answer As Long
Dim i As Byte, j As Byte, b As Integer, c As Integer
Dim pattern(), epigone(), buffer() 'массивы для считывания чисел (и последующего сравнения)'
Dim AbsentIn2ndRow As Boolean, POVTOR As Boolean
Dim L1 As String, L2 As String, L3 As String, OUT As String

L1 = "A1": L2 = "A2": L3 = "A3": OUT = "3:3": DIRE = "" & Chr(123) & "right" & Chr(125) & ""
If answer = 0 Then answer = MsgBox("Перейдём, может, лучше к колонкам?", vbYesNo + vbDefaultButton2)
If answer = vbYes Then _
L1 = "A1": L2 = "B1": L3 = "C1": OUT = "C:C": DIRE = "" & Chr(123) & "down" & Chr(125) & ""

Range(L1).Select 'считываем 1-й массив'
If IsEmpty(ActiveCell) Then MsgBox "Ячейка " & L1 & " пуста.": Exit Sub
DataLoading pattern '"накачка" 1-го массива'

Range(L2).Select 'считываем 2-й массив'
If IsEmpty(ActiveCell) Then MsgBox "Ячейка " & L2 & " пуста.": Exit Sub
DataLoading epigone '"накачка" 2-го массива'

ReDim buffer(UBound(pattern)) 'буферный массив - для избежания повторов в 3-м ряду'

Cells.Range(OUT).Clear    'очистили 3-й ряд - для печати разности 1-го и 2-го
Range(L3).Select          'выделили ячейку A3



Do While i <= UBound(pattern)            'перебор элементов 1-го массива'
        If Not POVTOR Then
            AbsentIn2ndRow = True 'предполагаем, что очередного эл-та из 1-го массива во 2-м нет'
        
            For j = 0 To UBound(epigone) 'перебор элементов 2-го массива'
                If epigone(j) = pattern(i) Then AbsentIn2ndRow = False: Exit For
                'выход - дальше сравнивать нет смысла: эл-т из pattern найден в epigone'
            Next j
            
            If AbsentIn2ndRow Then
                ActiveCell = pattern(i)     'печать очередного несовпадения'
                buffer(c) = pattern(i)      'запомним этот эл-т: он уже напечатан'
                c = c + 1       'подготовили индекс, возможно, для следующего повтора'
                SendKeys DIRE, True    'перешли в соседнюю ячейку (направо либо вниз)'
            End If
        End If
                
        If i = UBound(pattern) Then Exit Do '***ВЫХОД***'
            
        POVTOR = False
        i = i + 1          'СЛЕДУЮЩИЙ индекс 1-го массива'
    
        For b = 0 To c - 1
        If buffer(b) = pattern(i) Then POVTOR = True
        Next b
        
Loop


If IsEmpty(Range(OUT)) Then _
MsgBox "2-я " & IIf(answer, "колонка", "строка") & " включает в себя " & _
"(хотя бы один раз) все элементы, что идут до пробела в ячейках 1-й."

End Sub


Sub DataLoading(m()): Dim k As Byte
Do While Not IsEmpty(ActiveCell) 'пока в очередной ячейке не пусто'
    ReDim Preserve m(k) 'добавляем массиву размерность (до k), сохраняя данные'
    m(k) = ActiveCell
    SendKeys DIRE, True: k = k + 1 'ползём вправо (если строка) либо вниз (по столбцу) '
Loop
End Sub

[Slavik]

бОЛЬШОЕ СПАСИБО ПАРНИ!

[Sasha_Smirnov]

Сообщение от Sasha_Smirnov

If IsEmpty(Range(OUT)) Then _
MsgBox "2-я " & IIf(answer, "колонка", "строка") & " включает в себя " & _
"(хотя бы один раз) все элементы, что идут до пробела в ячейках 1-й."

не пашет!
Там, чтоб работало, должен бьiть

If IsEmpty(Range(L3)) Then _

и далее — как было.

[Sasha_Smirnov]

Теперь (из-за константы vbYes = 6) рабочий код немного не такой.

	
	
Option Explicit
Dim DIRECTION As String

Sub SeeTheDifference() 'печатает (в Excel, в 3-й строке либо в 3-м столбце - по вашему выбору)'
'такие элементы множества 1 (строка/столбец 1), каких нет во 2-м множестве (строка/столбец 2)'
Static answer As Long
Dim i As Byte, j As Byte, b As Integer, c As Integer
Dim pattern(), epigone(), buffer() 'массивы для считывания чисел (и последующего сравнения)'
Dim AbsentIn2ndRow As Boolean, POVTOR As Boolean
Dim L1 As String, L2 As String, L3 As String, OUT As String

L1 = "A1": L2 = "A2": L3 = "A3": OUT = "3:3": DIRECTION = "" & Chr(123) & "right" & Chr(125) & ""
If answer = 0 Then answer = MsgBox("Перейдём к колонкам?", vbYesNo + vbDefaultButton2)
If answer = vbYes Then _
L1 = "A1": L2 = "B1": L3 = "C1": OUT = "C:C": DIRECTION = "" & Chr(123) & "down" & Chr(125) & ""

Range(L1).Select 'считываем 1-й массив'
If IsEmpty(ActiveCell) Then MsgBox "Ячейка " & L1 & " пуста.": Exit Sub
DataLoading pattern '"накачка" 1-го массива'

Range(L2).Select 'считываем 2-й массив'
If IsEmpty(ActiveCell) Then MsgBox "Ячейка " & L2 & " пуста.": Exit Sub
DataLoading epigone '"накачка" 2-го массива'

ReDim buffer(UBound(pattern)) 'буферный массив - для избежания повторов в 3-м ряду'

Cells.Range(OUT).Clear    'очистили 3-й ряд - для печати разности 1-го и 2-го
Range(L3).Select          'выделили ячейку A3



Do While i <= UBound(pattern)            'перебор элементов 1-го массива'
        If Not POVTOR Then
            AbsentIn2ndRow = True 'предполагаем, что очередного эл-та из 1-го массива во 2-м нет'
        
            For j = 0 To UBound(epigone) 'перебор элементов 2-го массива'
                If epigone(j) = pattern(i) Then AbsentIn2ndRow = False: Exit For
                'выход - дальше сравнивать нет смысла: эл-т из pattern найден в epigone'
            Next j
            
            If AbsentIn2ndRow Then
                ActiveCell = pattern(i)     'печать очередного несовпадения'
                buffer(c) = pattern(i)      'запомним этот эл-т: он уже напечатан'
                c = c + 1       'подготовили индекс, возможно, для следующего повтора'
                SendKeys DIRECTION, True    'перешли в соседнюю ячейку (направо либо вниз)'
            End If
        End If
                
        If i = UBound(pattern) Then Exit Do '***ВЫХОД***'
            
        POVTOR = False
        i = i + 1          'СЛЕДУЮЩИЙ индекс 1-го массива'
    
        For b = 0 To c - 1
        If buffer(b) = pattern(i) Then POVTOR = True
        Next b
        
Loop


If IsEmpty(Range(L3)) Then _
MsgBox "2-я " & IIf(answer = vbYes, "колонка", "строка") & " включает в себя " & _
"(хотя бы один раз) все элементы, что идут до пробела в ячейках 1-й."

End Sub


Sub DataLoading(m()): Dim k As Byte
Do While Not IsEmpty(ActiveCell) 'пока в очередной ячейке не пусто'
    ReDim Preserve m(k) 'добавляем массиву размерность (до k), сохраняя данные'
    m(k) = ActiveCell
    SendKeys DIRECTION, True: k = k + 1 'ползём вправо (если строка) либо вниз (по столбцу) '
Loop
End Sub