Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 56972
Главная » Готовые решения » VBA » Полезные приёмы

Сравнить данные на двух листах и выделить отличия по определенному столбцу
19.11.2013, 21:19
[ Файл-пример (27.5 Kb) ]

Option Explicit
Option Compare Text

Sub ertert()
Dim x, i&: Application.ScreenUpdating = False
With Sheets("Incident Management")
 x = .Range("E1:G" & .Cells(Rows.Count, 5).End(xlUp).Row).Value
End With
With CreateObject("Scripting.Dictionary")
 .CompareMode = 1
 For i = 2 To UBound(x)
 .Item(x(i, 1)) = x(i, 3)
 Next i
 
 With Sheets("Open Incidents")
 With .Range("D1:G" & .Cells(Rows.Count, 4).End(xlUp).Row)
 x = .Value
 .Columns(4).Offset(1).Interior.Color = xlNone
 End With
 .Activate
 End With
 
 For i = 2 To UBound(x)
 If .Exists(x(i, 1)) Then
 If .Item(x(i, 1)) <> x(i, 4) Then Cells(i, 7).Interior.ColorIndex = 45
 End If
 Next i
End With
Application.ScreenUpdating = True
End Sub
Добавил: nilem |
Просмотров: 17941 | Рейтинг: 5.0/2
Всего комментариев: 1
0  
1    PaLbI4   (29.11.2013 17:35) [ Материал]
   Вот еще пример попроще (сравниваем 2 листа по колонке вхождением)

Sub dfd()
On Error Resume Next
Set xs = ThisWorkbook.Worksheets(1)
Set xs1 = ThisWorkbook.Worksheets(3)
i = 1
While xs1.Cells(i, 1).Value <> ""
b = xs1.Cells(i, 1).Value
Set c = xs.Range("W:W").Find(b, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
c.Interior.ColorIndex = 36
Set c = xs.Range("W:W").FindNext©
Loop While Not c Is Nothing And c.Address <> firstAddress
End If

i = i + 1
debug.print i
Wend

End Sub

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!