Уникальные значения из двух файлов

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Уникальные значения из двух файлов (Макросы Sub)

SkyPro

Дата: Понедельник, 26.08.2013, 22:04 | Сообщение № 1

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация: 255 ±

Замечаний: 0% ±

2010

Добрый вечер, уважаемые.
Помогите, пожалуйста, решить запрос.

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

К примеру есть функция, которая выдает уникальные значения из одного диапазона:
[vba]

Код

Function Unique(ByVal rRange) As Collection
      Set Unique = New Collection
      On Error Resume Next
      For Each rCell In rRange
      If Len(Trim(rCell)) <> 0 Then
           Unique.Add CStr(rCell), CStr(rCell)
      End If
      Next
End Function

[/vba]

Таким образом выводим уникальные:
[vba]

Код

Sub rrr()
For Each v In Unique([a1:a10])
Debug.Print v
Next
End Sub

[/vba]
Как эту функцию заставить брать диапазоны из двух файлов и выбирать из них уникальные?

skypro1111@gmail.com

Сообщение отредактировал SkyPro - Понедельник, 26.08.2013, 22:07

Ответить

SkyPro

Дата: Понедельник, 26.08.2013, 22:16 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация: 255 ±

Замечаний: 0% ±

2010

Кажется, получилось

[vba]

Код

Function Unique(ByVal rRange1, rRange2) As Collection
     Set Unique = New Collection
     On Error Resume Next
     For Each rCell In rRange1
     If Len(Trim(rCell)) <> 0 Then
          Unique.Add CStr(rCell), CStr(rCell)
     End If
     Next

     For Each rCell In rRange2
     If Len(Trim(rCell)) <> 0 Then
          Unique.Add CStr(rCell), CStr(rCell)
     End If
     Next

End Function

Sub rrr()
Set sh1 = Workbooks(1).Sheets(1).[a1:a10]
Set sh2 = Workbooks(2).Sheets(1).[a1:a10]
For Each v In Unique(sh1, sh2)
Debug.Print v
Next
End Sub

[/vba]

skypro1111@gmail.com

Ответить

Уникальные значения из двух файлов (Макросы Sub)

Страница 1 из 1
1