Страницы: 1
RSS
Разность двух массивов с помощью коллекции
 
Доброго времени суток!

Есть задача:
Сравнить данные на двух листах, по первому столбцу. Строки которые, не совпали нужно вывести на отдельный лист. Метод построчного перебора данных в цикле отпадает, т.к. строк несколько тысяч. Пробовал решить с помощью массивов, но в этом случае не выходит сравнить элементы массивов именно на неравенство, работает только со знаком "=". Наткнулся на просторах рунета на такой код:

Скрытый текст


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

Скрытый текст


Подсвечивается строка функции:
Код
tempItems.Add item, item

с Run-time error 13 type mismatch

Файл с примером в аттачменте. Первые два листа с данными, третий лист с результатом. Помогите, пожалуйста, разобраться с решением задачи.
Изменено: Hostyle - 04.08.2018 21:29:52
 
Ключ в коллекции должен быть текстовым, т.е string
P.S. а пример не работает вообще, и править его лень... Да и зачем?
Изменено: Hugo - 04.08.2018 22:11:00
 
Цитата
Hugo написал:
Ключ в коллекции должен быть текстовым, т.е string
Отнюдь, сэр! Тогда выходит Compile error: For Each Control variable must be Variant or Object.
Цитата
Hugo написал:
P.S. а пример не работает вообще, и править его лень... Да и зачем?
Вы про оригинальный пример? Ну там просто нет вывода результата на лист. Я его выводил - работает.
 
Цитата
Hostyle написал:
Отнюдь, сэр!
Тогда выполните этот макрос
Код
Sub TestArrayDifference() 
  Dim array1, array2 As Variant
  Dim newEmploy, escEmploy As Variant
  array1 = Array(1, 2, 3, 4) 
  array2 = Array(5, 6, 3, 4) 
  newEmploy = ArraysDifference(array1, array2) 
  escEmploy = ArraysDifference(array2, array1) 
End Sub
 
Код
Function DiffArrays(a, b)
Dim I&, J&, N&, c()
On Error Resume Next
With CreateObject("Scripting.Dictionary")
    For I = LBound(a) To UBound(a)
        For J = LBound(a, 2) To UBound(a, 2)
            iTemp = .item(a(I, J))
        Next
    Next
    For I = LBound(b) To UBound(b)
        For J = LBound(b, 2) To UBound(b, 2)
            If Not .Exists(b(I, J)) Then
                ReDim Preserve c(N)
                c(N) = b(I, J)
                N = N + 1
            End If
        Next
    Next
End With
DiffArrays = Application.Transpose(c)
End Function

Sub TestArrayDifference()
  Dim array1, array2 As Variant
  Dim result1, result2 As Variant
  Dim arr, arrSec
   
  With Workbooks("test.xlsm").Worksheets("Лист1")
array1 = .Range("B1", .Cells(.Rows.count, "A").End(xlUp)).Value
End With
  With Workbooks("test.xlsm").Worksheets("Лист2")
array2 = .Range("B1", .Cells(.Rows.count, "A").End(xlUp)).Value
End With
  
  result1 = DiffArrays(array1, array2)
   
With Workbooks("test.xlsm").Worksheets("разность")
     .Cells(1, 1).Resize(UBound(result1), 1) = result1
End With
End Sub
Согласие есть продукт при полном непротивлении сторон
 
Цитата
RAN написал:
Тогда выполните этот макрос
type mismatch. Что это нам дает?
 
Это нам дает подтверждение слов Hugo,
 
Цитата
RAN написал:
Это нам дает подтверждение слов  Hugo ,
Ну здорово. Только при условии, что ключи текстовые - макрос ТАК ЖЕ дальше не работает.
 
Сообщение #5 видели?
Согласие есть продукт при полном непротивлении сторон
 
Sanja, Спасибо! Потестирую Ваш вариант.
 
Цитата
Sanja написал:
Сообщение #5 видели?
Видел, спасибо. Потестирую в рабочем режиме, отпишусь в теме.
 
Цитата
Hostyle написал:
ТАК ЖЕ дальше не работает.
Не надо ТАК ЖЕ. Надо правильно.
Код
Function ArraysDifference(primArray As Variant, secondArray As Variant) As Variant
    Dim newItems() As String
    Dim item As Variant
    Dim tempItems As New Collection
    Dim count As Integer
    For Each item In primArray
        tempItems.Add item, CStr(item)
    Next item
    count = 0
    For Each item In secondArray
        On Error Resume Next
        tempItems.Add item, CStr(item)
        If Err = 0 Then
            count = count + 1
            ReDim Preserve newItems(count)
            newItems(count) = item
        End If
        On Error GoTo 0
    Next item
    ArraysDifference = newItems
End Function

Sub TestArrayDifference()
    Dim array1, array2 As Variant
    Dim newEmploy, escEmploy As Variant
    Dim arr, arrSec
    '?????????? ? ?????? ??????
    With Worksheets("Лист1")
        array1 = .Range("A1", .Cells(.Rows.count, "A").End(xlUp)).Value
    End With
    '?????????? ? ????? ??????
    With Worksheets("Лист2")
        array2 = .Range("A1", .Cells(.Rows.count, "A").End(xlUp)).Value
    End With
    newEmploy = ArraysDifference(array1, array2)
    '???????? ??????????
    escEmploy = ArraysDifference(array2, array1)
    Worksheets("разность").Cells(1, 1).Resize(UBound(escEmploy)) = Application.Transpose(escEmploy)
End Sub
 
Цитата
Hostyle написал:
Ну там просто нет вывода результата на лист
- а кроме того нет такого файла, всех трёх листов, как следствие непонятно что вообще с чем сравниваете... Ну а ошибку я назвал.
 
Цитата
Hugo написал:
- а кроме того нет такого файла, всех трёх листов, как следствие непонятно что вообще с чем сравниваете... Ну а ошибку я назвал.
Ну естественно, что там ничего этого нет - код с другого форума, написан более 10 лет назад другим человеком, под другие задачи. Я привел его без изменений, ту часть которую я изменил привел блоком кода ниже в этом же сообщении.
 
Sanja,
Макрос погонял: на лист с результатом копируется столбец "B" с листа "Лист2".  Возможно, я не совсем ясно изложил задачу в первом посте, извиняюсь. По идее должны сравниваться  ячейки столбцов "A" с листов "Лист1" и "Лист2"  - НЕсовпавшие строки должны отобразиться на листе "разность". Столбцы "B" не сравниваются, но на листе с результатом должны быть строки полностью - ячейки столбца "A" и столбца "B".

P.S. Если использовать result2, то выгружает почти правильный результат - почему-то идёт вперемежку столбец "A" со столбцом "B", но с этим, впринципе, жить можно. Еще раз, Спасибо!
Изменено: Hostyle - 05.08.2018 13:04:16
 
Доброе время суток.
Коллеги, а не проще ли такую задачу через SQL делать? Файл сохранить в папку c:\path.
 
Хе, хе. Пока ТС думает и молчит как партизан, добавил версию на Power Query.
 
Андрей VG, Спасибо за варианты) Хотелось бы обойтись силами VBA.
 
Цитата
Hostyle написал:
силами VBA.
Силами VBA, но через SQL ;)
 
Цитата
Андрей VG написал:
Силами VBA, но через SQL
Я нифига не понял, что это было, но это работает!  :D Спасибо, годный вариант.)
 
Цитата
Hostyle написал #1:
Пробовал решить с помощью массивов, но в этом случае не выходит сравнить элементы массивов именно на неравенство
Скрытый текст
Изменено: С.М. - 06.08.2018 01:37:25
Страницы: 1
Наверх