Excel vba как сравнить ячейки

Операторы сравнения чисел и строк, ссылок на объекты (Is) и строк по шаблону (Like), использующиеся в VBA Excel. Их особенности, примеры вычислений.

Операторы сравнения чисел и строк

Операторы сравнения чисел и строк представлены операторами, состоящими из одного или двух математических знаков равенства и неравенства:

  • <   – меньше;
  • <= – меньше или равно;
  • >   – больше;
  • >= – больше или равно;
  • =   – равно;
  • <> – не равно.

Синтаксис:

Результат = Выражение1 Оператор Выражение2

  • Результат – любая числовая переменная;
  • Выражение – выражение, возвращающее число или строку;
  • Оператор – любой оператор сравнения чисел и строк.

Если переменная Результат будет объявлена как Boolean (или Variant), она будет возвращать значения False и True. Числовые переменные других типов будут возвращать значения 0 (False) и -1 (True).

Операторы сравнения чисел и строк работают с двумя числами или двумя строками. При сравнении числа со строкой или строки с числом, VBA Excel сгенерирует ошибку Type Mismatch (несоответствие типов данных):

Sub Primer1()

On Error GoTo Instr

Dim myRes As Boolean

‘Сравниваем строку с числом

  myRes = «пять» > 3

Instr:

If Err.Description <> «» Then

  MsgBox «Произошла ошибка: « & Err.Description

End If

End Sub

Сравнение строк начинается с их первых символов. Если они оказываются равны, сравниваются следующие символы. И так до тех пор, пока символы не окажутся разными или одна или обе строки не закончатся.

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

myRes = «семь» > «восемь» ‘myRes = True

myRes = «Семь» > «восемь» ‘myRes = False

myRes = Len(«семь») > Len(«восемь») ‘myRes = False

Оператор Is – сравнение ссылок на объекты

Оператор Is предназначен для сравнения двух переменных со ссылками на объекты.

Синтаксис:

Результат = Объект1 Is Объект2

  • Результат – любая числовая переменная;
  • Объект – переменная со ссылкой на любой объект.

Если обе переменные Объект1 и Объект2 ссылаются на один и тот же объект, Результат примет значение True. В противном случае результатом будет False.

Set myObj1 = ThisWorkbook

Set myObj2 = Sheets(1)

Set myObj3 = myObj1

Set myObj4 = Sheets(1)

myRes = myObj1 Is myObj2 ‘myRes = False

myRes = myObj1 Is myObj3 ‘myRes = True

myRes = myObj2 Is myObj4 ‘myRes = True

По-другому ведут себя ссылки на диапазоны ячеек. При присвоении ссылок на один и тот же диапазон нескольким переменным, в памяти создаются уникальные записи для каждой переменной.

Set myObj1 = Range(«A1:D4»)

Set myObj2 = Range(«A1:D4»)

Set myObj3 = myObj1

myRes = myObj1 Is myObj2 ‘myRes = False

myRes = myObj1 Is myObj3 ‘myRes = True

Оператор Like – сравнение строк по шаблону

Оператор Like предназначен для сравнения одной строки с другой по шаблону.

Синтаксис:

Результат = Выражение Like Шаблон

  • Результат – любая числовая переменная;
  • Выражение – любое выражение, возвращающее строку;
  • Шаблон – любое строковое выражение, которое может содержать знаки подстановки.

Строка, возвращенная аргументом Выражение, сравнивается со строкой, возвращенной аргументом Шаблон. Если обе строки совпадают, переменной Результат присваивается значение True, иначе – False.

myRes = «восемь» Like «семь»  ‘myRes = False

myRes = «восемь» Like «*семь»  ‘myRes = True

myRes = «Куда идет король» Like «идет»  ‘myRes = False

myRes = «Куда идет король» Like «*идет*»  ‘myRes = True

Со знаками подстановки для оператора Like вы можете ознакомиться в статье Знаки подстановки для шаблонов.

2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

1

Сравнение двух диапазонов ячеек на совпадение

29.05.2012, 00:04. Показов 23504. Ответов 20


Студворк — интернет-сервис помощи студентам

Здравствуйте! Подскажите пожалуйста…
Имеется 2 диапазона ячеек А1:A3 и C1:C3, в которых забиты цифры, допустим в ячейках А1:A3 (3,6,2 соответственно), а в C1:C3 (2, 4, 8) и мне необходимо, чтобы при нахождении одинаковых значений выводилось сообщение. Спасибо



0



Апострофф

Заблокирован

29.05.2012, 06:59

2

Visual Basic
1
2
3
4
5
6
7
8
Sub cmp()
Dim a As Range, c As Range
For Each a In [A1:A3]
  For Each c In [C1:C3]
    If a = c Then MsgBox a & "=" & c
  Next c
Next a
End Sub



1



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

31.05.2012, 13:37

 [ТС]

3

Спасибо, а как сделать чтобы этот же код продолжал работать в след.ячейках например не А1:А3 и С1:С3, а изменил диапазон со сдвигом вправо, т.е. В1:В3 и D1: D3 стало, чтобы не писать его для всех ячеек, а просто со сдвигом вправо? Спасибо



0



Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

01.06.2012, 09:20

4

И сколько таких сдвигов планируется?



0



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

01.06.2012, 13:00

 [ТС]

5

Примерно 30 сдвигов



0



Dragokas

Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

01.06.2012, 16:15

6

Лучший ответ Сообщение было отмечено как решение

Решение

1. Прокрутка через смещения
2. Исключено сравнение пустых строк
3. Информация о позиции найденных ячеек

Visual Basic
1
2
3
4
5
6
7
8
9
Sub cmp()
Dim a As Range, c As Range, n As Integer
For n = 0 To 30 'êîë-âî ñìåùåíèé
  For Each a In [A1:A3].Offset(, n)
    For Each c In [C1:C3].Offset(, n)
      If a = c And Len(a) <> 0 Then MsgBox a & "=" & c & " (" & _
        Replace(a.Address & " = " & c.Address & ")", "$", "")
Next c, a, n
End Sub



4



ikki

призрак

3261 / 889 / 119

Регистрация: 11.05.2012

Сообщений: 1,702

Записей в блоге: 2

01.06.2012, 16:38

7

Цитата
Сообщение от Diskretor
Посмотреть сообщение

Visual Basic
1
Replace(a.Address & " = " & c.Address & ")", "$", "")

а так не проще?

Visual Basic
1
a.Address(0,0) & " = " & c.Address(0,0)



0



Dragokas

01.06.2012, 17:23

Не по теме:

Да, я забыл как это делается. Спасибо.



0



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

01.06.2012, 22:54

 [ТС]

9

Спасибо!

Цитата
Сообщение от Diskretor
Посмотреть сообщение

Len(a) <> 0

а что значит эта строка?



0



Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

02.06.2012, 05:16

10

Без нее, если попадутся 2 пустые ячейки, начнет писать о совпадении.

У меня они были почти все пустые, поэтому я это дело отключил.



1



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

02.06.2012, 08:45

 [ТС]

11

Спасибо! Как раз то, что нужно.



0



irealife

2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

03.07.2012, 23:15

 [ТС]

12

Visual Basic
1
2
3
4
5
6
Dim a As Range, c As Range, n As Integer
For n = 0 To 150 Step 3 'кол-во смещений
  For Each a In [F3:H3].Offset(, n)
    For Each c In [CC3:CE3].Offset(, n)
      If a = c And Len(a) <> 0 Then letters8 = letters8 + 1
Next c, a, n

Подскажите пожалуйста, а как написать так, чтобы к letters8 прибавлялось 1 при одном совпадении и прибавлялась 2 при больше двух совпадениях.



0



Dragokas

Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

04.07.2012, 02:51

13

Если правильно Вас понял, общее кол-во совпадений считаем, как сумму любых совпадений значений в 3 х 3 ячеек в текущем смещении. При этом, если совпадений ровно 2, то ничего не прибавляем.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim a As Range, c As Range, n As Integer, k As Integer
For n = 0 To 150 Step 3 'кол-во смещений
  k = 0
  For Each a In [F3:H3].Offset(, n)
    For Each c In [CC3:CE3].Offset(, n)
      If a = c And Len(a) <> 0 Then k = k + 1
    Next
  Next
  Select Case k
    Case 1
      letters8 = letters8 + 1
    Case Is > 2
      letters8 = letters8 + 2
  End Select
Next



1



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

07.07.2012, 13:52

 [ТС]

14

При выполнении данного кода, у меня при 1 совпадении все правильно происходит, а при больше двух к letters8 прибавляется 5 вместо 2.



0



Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

07.07.2012, 14:09

15

Так здесь добавляется сразу же, как только найдет совпадения в одном смещении.
А Вам нужно, чтобы после просчета всех 150/3 ?

Тогда строку № 15 переместите между 8 и 9 (а № 3 удалить).



1



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

07.07.2012, 15:31

 [ТС]

16

У меня снова не выходит, теперь получается так, что при любом количестве совпадений прибавляется к letters8 значение 2, а должно, чтобы при отсутствии совпадений — не прибавляться ничего, при одном совпадении — прибавляться единица. И проблема по-моему в переменной k. Я в ячейки добавляю все разные значения, а k он мне выводит равное трем, поэтому и прибавляется все время 2 к letters8.



0



Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

07.07.2012, 22:30

17

Можете выложить файл с некоторыми фрагментами цифер для теста.



1



2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

08.07.2012, 01:15

 [ТС]

18

А вы можете почту написать свою? я на почту скину файл?

Добавлено через 2 часа 23 минуты
Diskretor, спасибо! Я поняла в чем ошибка была)

Добавлено через 13 минут
Последний вопрос по теме: имеется массив значений в excel и выполняется огромный код на строку 3. Необходимо сделать так, чтобы этот же код выполнялся на все заполненные последующие строки в excel. В самом коде было использовано свойство Range с конкретным указанием на ячейки в строке.



0



Dragokas

Эксперт WindowsАвтор FAQ

17991 / 7617 / 890

Регистрация: 25.12.2011

Сообщений: 11,351

Записей в блоге: 17

08.07.2012, 02:03

19

Да? А я — нет. Можете просветить, чтобы в следующий раз тоже знать как правильно объяснять?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Dim Rng As Range, c As Range, n%, k%, R%
Dim letters8(3 To 10)
For R = 3 To 10 'номера строк
  For n = 0 To 150 Step 3 'кол-во смещений
    k = 0 'в каждом смещении вправо K подсчитываем отдельно
    For Each Rng In Range("F" & R & ":H" & R).Offset(, n)
      For Each c In Range("CC" & R & ":CE" & R).Offset(, n)
        If Rng = c And Len(Rng) <> 0 Then k = k + 1
      Next
    Next
    Select Case k
      Case 1
        letters8(R) = letters8(R) + 1
      Case Is > 2
        letters8(R) = letters8(R) + 2
    End Select
  Next n
Next R

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



1



irealife

2 / 2 / 0

Регистрация: 10.05.2012

Сообщений: 45

08.07.2012, 10:30

 [ТС]

20

Вы в самом начале правильно мне все написали, ошибка у меня была в диапазоне: было от 0 до 150, а нужно было от 0 до 75, и в кейсах у меня он не понимал что такое Case 1, поэтому я ему указала конкретно на равенство через Case Is. И все, спасибо вам)

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim a As Range, c As Range, n As Integer, k As Integer
For n = 0 To 75 Step 3 'кол-во смещений
  For Each a In [F3:H3].Offset(, n)
    For Each c In [CC3:CE3].Offset(, n)
      If a = c And Len(a) <> 0 Then k = k + 1
    Next
  Next
Next
'MsgBox k
  Select Case k
    Case Is = 1
      letters8 = letters8 + 1
    Case Is >= 2
      letters8 = letters8 + 2
  End Select



0



VBA сравнение ячеек и значений

AxelTT

Дата: Пятница, 14.10.2016, 01:27 |
Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

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


Excel 2013

Не могу реализовать VBA сравнение

Есть данные :
1) Столбец из 100-400 ячеек в каждой ячейке находится 16значный алфавитно-цифровой номер.
Например :
DAX2009855855555
AUC2009849066666

2) Каждому номер нужно едино разово присвоить значение
Например :
DAX2009855855555 это = « ручные весы v23 »
AUC2009849066666 это = « самовар v3 »

Каждый день я получаю номера из 100- 400 ячеек и нужно что бы их проверило на то значение что я им присвоил п.2. И вывело список товара, а если значение не присвоено в п.2, то что бы выводилась надпись например NEW, и по возможности что бы список товара выводился в те же ячейке в которых находился 16ти значный код.

Думаю что это возможно сделать на VBA в Excel, но к сожалению мои познания не позволяют это сделать.

Помогите пожалуйста!

 

Ответить

Pelena

Дата: Пятница, 14.10.2016, 08:50 |
Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 18797


Репутация:

4284

±

Замечаний:
±


Excel 2016 & Mac Excel

Файл с примером помог бы в понимании задачи


«Черт возьми, Холмс! Но как??!!»
Ю-money 41001765434816

 

Ответить

Hugo

Дата: Пятница, 14.10.2016, 08:50 |
Сообщение № 3

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

Ранг: Участник клуба

Сообщений: 3140


Репутация:

670

±

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


2010, теперь уже с PQ

Это можно сделать с помощью функций листа ВПР() и ЕСЛИ() и чуть поработать руками, если нужно (копирование-спецвставка).


excel@nxt.ru
webmoney: R418926282008 Z422237915069

 

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 10:28 |
Сообщение № 4

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

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


Excel 2013

Рабочий файлик который каждый день приходит с новыми номерами называется TMP V1.xlsx
Номера с которыми работать в столбце К

Ну и собственно база товара в файлике BD.xlsx может быть эту базу можно как то разместить внутри кода VBA?

Задача что бы сравнило код в ячейках столбца К с БД и вставило в ячейки столбца К данные с БД

На данном уровне для меня эта задача не выполнима, помогите пожалуйста

 

Ответить

Manyasha

Дата: Пятница, 14.10.2016, 11:41 |
Сообщение № 5

Группа: Модераторы

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

Сообщений: 2198


Репутация:

898

±

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


Excel 2010, 2016

AxelTT, так подойдет?
[vba]

Код

Sub compareData()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    Dim i&, newWB As Workbook, dic As Object
    Set dic = CreateObject(«scripting.dictionary»)
    With ThisWorkbook.Sheets(1)
        For i = 5 To .Cells(Rows.Count, «d»).End(xlUp).Row
            dic(Trim(.Cells(i, «d»))) = .Cells(i, «f»)
        Next i
    End With
    Set newWB = Workbooks.Open(ThisWorkbook.Path & «TMP_V1.xlsx»)
    With newWB.Sheets(1)
        For i = 7 To .Cells(Rows.Count, «k»).End(xlUp).Row
            If dic.exists(Trim(.Cells(i, «k»))) Then
                .Cells(i, «k») = dic(Trim(.Cells(i, «k»)))
            Else
                .Cells(i, «k») = «New»
            End If
        Next i
    End With
    newWB.Save
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

[/vba]


ЯД: 410013299366744 WM: R193491431804

 

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 15:39 |
Сообщение № 6

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

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


Excel 2013

Manyasha,

спасибочки, буду разбираться

 

Ответить

Hugo

Дата: Пятница, 14.10.2016, 15:50 |
Сообщение № 7

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

Ранг: Участник клуба

Сообщений: 3140


Репутация:

670

±

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


2010, теперь уже с PQ

Manyasha, тут точки не хватает перед Rows:
[vba]

Код

With ThisWorkbook.Sheets(1)
        For i = 5 To .Cells(Rows.Count,

[/vba]
т.к. в такой комбинации условий ThisWorkbook и активная книга могут быть из разных поколений, что иногда может привести к браку в работе.


excel@nxt.ru
webmoney: R418926282008 Z422237915069

 

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 16:19 |
Сообщение № 8

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

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


Excel 2013

Странно, при первом нажатии на кнопку Сравнение вроде все ОК, но если нажать повторно на Сравнение то все ячейки К принимают значение NEW.
Это только у меня так? %)

 

Ответить

Manyasha

Дата: Пятница, 14.10.2016, 16:32 |
Сообщение № 9

Группа: Модераторы

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

Сообщений: 2198


Репутация:

898

±

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


Excel 2010, 2016

Hugo, Вы правы, я 2003-м не пользуюсь (да и на работе таких нет), поэтому допускаю такую запись)

AxelTT,

Задача что бы сравнило код в ячейках столбца К с БД и вставило в ячейки столбца К данные с БД

после запуска макроса, данные в столбце К уже не являются кодом.
Можно проставлять код в соседний столбец:
[vba]

Код

    With newWB.Sheets(1)
        For i = 7 To .Cells(Rows.Count, «k»).End(xlUp).Row
            If dic.exists(Trim(.Cells(i, «k»))) Then
                .Cells(i, «l») = dic(Trim(.Cells(i, «k»)))’код пишем в столбец L
            Else
                .Cells(i, «l») = «New»
            End If
        Next i
    End With

[/vba]


ЯД: 410013299366744 WM: R193491431804

 

Ответить

AxelTT

Дата: Пятница, 14.10.2016, 17:14 |
Сообщение № 10

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

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


Excel 2013

Manyasha,
ну может быть можно как то придумать что бы при повторном нажатии оно не менялось на NEW плизз плизз hands respect

 

Ответить

Manyasha

Дата: Пятница, 14.10.2016, 21:45 |
Сообщение № 11

Группа: Модераторы

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

Сообщений: 2198


Репутация:

898

±

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


Excel 2010, 2016

AxelTT,
[vba]

Код

Sub compareData()
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    Dim i&, newWB As Workbook, dic As Object, j
    Set dic = CreateObject(«scripting.dictionary»)
    With ThisWorkbook.Sheets(1)
        For i = 5 To .Cells(Rows.Count, «d»).End(xlUp).Row
            For Each j In Array(4, 6) ‘столбцы D и F
                dic(Trim(.Cells(i, j))) = .Cells(i, «f»)
            Next j
        Next i
    End With
    Set newWB = Workbooks.Open(ThisWorkbook.Path & «TMP_V1.xlsx»)
    With newWB.Sheets(1)
        For i = 7 To .Cells(Rows.Count, «k»).End(xlUp).Row
            If dic.exists(Trim(.Cells(i, «k»))) Then
                .Cells(i, «k») = dic(Trim(.Cells(i, «k»)))
            Else
                .Cells(i, «k») = «New»
            End If
        Next i
    End With
    newWB.Save
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

[/vba]


ЯД: 410013299366744 WM: R193491431804

 

Ответить

AxelTT

Дата: Суббота, 15.10.2016, 00:15 |
Сообщение № 12

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6


Репутация:

0

±

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


Excel 2013

Manyasha,
ВОЛШЕБНИЦА!!! hands hands hands БОЛЬШОЕ СПАСИБО!!! respect respect respect оч хочется тебя отблагодарить!

 

Ответить

 

Gorr98

Пользователь

Сообщений: 17
Регистрация: 29.06.2016

Подскажите пожалуйста, как организовать поиск на несовпадение?
На первом листе таблицу надо сравнить с таблицей на втором листе. Если найдены несовпадения, добавить не совпавшее значение в таблицу на первом листе.
В моем коде вроде находится, но не добавляется.  

Прикрепленные файлы

  • П3.xlsm (20.69 КБ)

 

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

#2

29.06.2016 18:50:38

Цитата
Gorr98 написал:
В моем коде вроде находится, но не добавляется

Не находится, так как на втором листе нет значений, которые бы отсутствовали на первом.
См. мой вариант. Если значений ОЧЕНЬ много (тысячи строк), то есть смысл делать на массивах.
P.S. Чудной код у Вас )) Сами писали или где-то подсмотрели?

Прикрепленные файлы

  • П3 01.xlsm (22.26 КБ)

 

JeyCi

Пользователь

Сообщений: 3357
Регистрация: 27.11.2013

#3

29.06.2016 19:56:42

а что делать с дублями в 1-й таблице?
и можно ли итог отсортировать (особенность запросов — автосортировка по ключевому полю…
если 1-е) нет не нужны и 2-е) да можно…
то SQL-запрос на добавление новых будет выглядеть так (как вариант)… для разнообразия  

Код
SELECT t.Номер FROM `Лист1$` t
UNION
SELECT ttt.Номер FROM `Лист2$` ttt
WHERE ttt.Номер NOT IN (
SELECT t.Номер FROM `Лист1$` t
INNER JOIN  `Лист2$` tt
ON t.Номер=tt.Номер)

файл в папку C:1

Прикрепленные файлы

  • П3.xlsm (21.75 КБ)

Изменено: JeyCi29.06.2016 20:20:29

чтобы не гадать на кофейной гуще, кто вам отвечает и после этого не совершать кучу ошибок — обратитесь к собеседнику на ВЫ — ответ на ваш вопрос получите — а остальное вас не касается (п.п.п. на форумах)

 

Мотя

Пользователь

Сообщений: 3218
Регистрация: 25.12.2012

#4

29.06.2016 20:43:07

Цитата
JeyCi написал:
а что делать с дублями в 1-й таблице?

1 таблица должна дополниться только новыми данными из 2 таблицы, т.е. 1 таблица может иметь кучу строк, представленных одним данным.

Gorr98

!
См. вариант «на массивах», о которых говорил

Юрий М

.

Прикрепленные файлы

  • П3-1.xlsm (23.02 КБ)

 

Gorr98

Пользователь

Сообщений: 17
Регистрация: 29.06.2016

Огого! Никогда бы не подумал, что это может быть так просто, да еще и в такое маленькое количество строк!

Спасибо большое, благодаря таким, как вы, чайники вроде меня черпают опыт чашками, а не ложками)

Насчет кода — да, согласен, очень чудной, может потому, что основу подсмотрел, а потом попытался сам его изменить.  

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

#6

30.06.2016 08:32:14

Цитата
Gorr98 написал:
да еще и в такое маленькое количество строк!

так показали бы тут код где ещё меньше строк — тот с кибера от fever brain :)

Код
Sub Сравнение()
    Dim r1 As Range, r2 As Range, v, w, i&
    With Sheets(1)
        Set r1 = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With
    With Sheets(2)
        Set r2 = .Range(.Cells(1, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 1))
    End With
 
    For Each v In r1
        For Each w In r2
            If v = w Then GoTo 1
        Next
        i = i + 1: Sheets(1).Cells(i, 3) = v
1
    Next
    MsgBox (Choose(Sgn(i) + 1, "Всё совпало", "Имеются различия смотрите колонку [C]"))
End Sub

Только тут у него идёт сравнение обратное заказанному, но не суть.
Да и там есть добавка:

Код
Сравниваем второй лист с первым наоборот:
 
    For Each v In r2
        For Each w In r1
            If v = w Then GoTo 1
        Next
        i = i + 1: Sheets(1).Cells(i, 3) = v
1
    Next

Если данных много — добавкой rn=rn.value можно анализ перевести в массивы (только тип rn убрать).

Изменено: Hugo30.06.2016 08:33:02

 

Gorr98

Пользователь

Сообщений: 17
Регистрация: 29.06.2016

#7

30.06.2016 16:59:30

Код
Sub Сравнить_2()
Dim i As Long, LastRow As Long, Rng As Range, FreeRow As Long
    FreeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Лист2")
        LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastRow
            Set Rng = Columns(1).Find(what:=.Cells(i, 1), LookIn:=xlFormulas, lookAt:=xlWhole)
            If Rng Is Nothing Then
                Cells(FreeRow, 1) = .Cells(i, 1)
                FreeRow = FreeRow + 1
            End If
        Next
    End With
End Sub

Юрий М, расскажите, пожалуйста, что означают приставки xl? Так и не смог разобраться. Знаю, что xlUp — это верхняя граница. Кстати, почему мы используем верхнюю границу, а не нижнюю? С нижней попробовал — не работает. Но ведь мы используем последнее значение снизу — почему тогда xlUp?

Set Rng = Columns(1).Find(what:=.Cells(i, 1), LookIn:=xlFormulas, lookAt:=xlWhole) — а в этой строке такая логика, что задаем Rng первую колонку и ищем ее в первой колонке добавленного листа, верно? Если да, то what тут означает «ищем совпадение»? А что значат LookIn и lookAt?

Надеюсь, что не сильно завалил вопросами  :oops:

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

По второму вопросу — задаём не первую колонку, а задаём найти. И ищем в первой колонке что, в чём и как.
И если нашлось, то… далее по коду.

А xlUp — это вверх. Вверх от в данном случае последней ячейки столбца, пока не наткнёмся на значение.
Можно идти и вниз от первой — но обычно ведь бывают пустые ячейки…

Юра, я пришёл — а тебя нет… :)

Изменено: Hugo30.06.2016 17:20:23

 

Юрий М

Модератор

Сообщений: 60570
Регистрация: 14.09.2012

Контакты см. в профиле

#9

30.06.2016 17:13:02

Всякие xl  — это своего рода константы-сокращения: xlFormulas, xlWhole, xlNone, XlYesNo и т.д. Т.е. «готовые к употреблению» параметры )

Цитата
Gorr98 написал:
что значат LookIn и lookAt?

what  — какое значение ищем.
LookIn  — где ищем. Варианты: значения или формулы.
lookAt — точное совпадение или частичное.

 

Gorr98

Пользователь

Сообщений: 17
Регистрация: 29.06.2016

О! с what, lookIn и lookAt понятно стало, а вот xlUp не совсем — выходит, да, бывают пустые ячейки, на которые xlDown наткнется и подумает, что это конец данных. Но xlUP ведь тоже должен тогда споткнуться об эту же пустую ячейку?
А насчет констант-сокращений — есть какой-то список этих сокращений?

И еще, если возможно, посоветуйте, пожалуйста, какую-нибудь литературу по vba  :)

 

Hugo

Пользователь

Сообщений: 23249
Регистрация: 22.12.2012

xlUP идёт снизу вверх, по пустым, он наткнётся на первую заполненную. Снизу!
А  xlDown пускают свеху вниз по полным, он тормознёт на пустой.
Иногда нужно использовать  xlDown — например чтоб пройтись по плотно заполненной таблице, под которой ниже ещё есть данные, после пустых ячеек.

список этих сокращений — в редакторе жмёте F2, там всё.

Изменено: Hugo30.06.2016 18:01:31

 

С.М.

Пользователь

Сообщений: 936
Регистрация: 22.12.2012

#12

30.06.2016 21:36:14

Вариант с xlDown:

Код
Sub Test2()
    Dim Rng1 As Range, Rng2 As Range, Counts(), Arr3(), N As Long, J As Long, K As Long
    Set Rng1 = Лист1.Range("A2")
    Set Rng1 = Range(Rng1, Rng1.End(xlDown))
    Set Rng2 = Лист2.Range("A2")
    Set Rng2 = Range(Rng2, Rng2.End(xlDown))
    Counts = Evaluate("INDEX(COUNTIF(" & Rng1.Address(External:=True) & "," & Rng2.Address(External:=True) & "),0,0)")
    N = Rng2.Rows.Count
    ReDim Arr3(1 To N, 1 To 1)
    For K = 1 To N
        If Counts(K, 1) = 0 Then
            J = J + 1
            Arr3(J, 1) = Rng2.Cells(K, 1)
        End If
    Next
    MsgBox "Найдено несовпадений: " & J, , ""
    Rng1.Cells(Rng1.Rows.Count + 1).Resize(N).Value = Arr3
End Sub

Прикрепленные файлы

  • Сравнение двух диапазонов на несовпадение.xls (55 КБ)

Перейти к основному содержанию

Статья даёт ответы на следующие вопросы:

  • Как сравнить две таблицы в Excel с помощью макросов VBA?
  • Как обращаться к ячейкам таблицы Excel с помощью VBA?
  • Как осуществлять перебор ячеек таблицы в цикле с помощью VBA?

В предыдущей статье Сравнение таблиц в Excel мы рассмотрели подход к сравнению сложных таблиц с использованием формул и без программирования.

В данной статье рассмотрим способ сравнения таблиц Excel с помощью VBA макросов на примере тех же исходных данных.

Проиллюстрируем задачу картинкой из первой статьи.

задача сравнения двух таблиц в Excel

Для начала напишем алгоритм наших действий по сравнению таблиц.

  1. Определим диапазоны данных первой и второй таблицы, то есть найдем последние значимые строки и сохраним их номера в переменных (последняя строка таблицы 1 — last_i и последняя строка таблицы 2 — last_j).
  2. Начнем проходить по каждой строке таблицы 2 (внешний цикл), данные из которой нужно перенести в таблицу 1. С первой строки данных (в примере это строка 3) до последней строки таблицы 2.
  3. Для каждой строки таблицы 2 определим идентификатор строки, путем формирования строки, содержащей полный адрес квартиры (значения из нескольких колонок, разделенные дефисами).
  4. Начнем проходить по каждой строке таблицы 1 (внутренний цикл) с первой строки данных (в примере это строка 3) до последней строки таблицы 1, определяя при этом идентификатор строки.
  5. Сравним значения идентификаторов строк таблицы 1 и таблицы 2.
  6. Если идентификаторы равны, перепишем ФИО покупателя из ячейки таблицы 2 в соответствующую ячейку таблицы 1; прервем внутренний цикл по таблице 1 и перейдем к следующей строке таблицы 2 (переход к п.2).

Теперь остается реализовать алгоритм в виде программного кода макроса.

Для этого откроем вкладку Вид ленты функций Excel. Щелкнем на нижнюю часть со стрелкой кнопки Макросы. В открывшемся подменю выберем Запись макроса. В результате начнется запись нового макроса. Поскольку код мы будем формировать вручную, то еще раз зайдем в подменю макросов и выберем Остановить запись. Далее еще раз войдем в подменю макросов и выберем Макросы.

В появившемся диалоге выделим наш макрос и нажмем Изменить.

На экране откроется окно редактора макросов Visual Basic for Applications. В области кода (правая верхняя область) отображается код только что созданного пустого макроса.

Редактор макросов Visual Basic For Applications

В процедуру Макрос1 (между объявлениями начала и конца процедуры: Sub и End Sub) необходимо вставить код, решающий поставленную задачу.
Образец кода представлен ниже.

Sub Макрос1()
'
' Макрос1 сравнение двух таблиц с использованием макроса VBA
'

' ссылка на первый лист книги
Dim sheet1 As Worksheet
Set sheet1 = ActiveWorkbook.Sheets(1)
' ссылка на второй лист книги
Dim sheet2 As Worksheet
Set sheet2 = ActiveWorkbook.Sheets(2)

' строка для хранения идентификатора строки первой таблицы
Dim str1 As String
' строка для хранения идентификатора строки второй таблицы
Dim str2 As String

' позиция курсора (номер строки) в первой таблице
Dim i As Integer
i = 3
Dim last_i As Integer
last_i = 3
' позиция курсора (номер строки) во второй таблице
Dim j As Integer
j = 3
Dim last_j As Integer
last_j = 3

' определяем последнюю значимую строку первой таблицы (последняя строка, в первой колонке которой есть значение)
For Each Cell In sheet1.Range("A:A")
    If Cell.Row > 2 Then
        If Cell.Value > "" Then
            last_i = Cell.Row
        Else
            Exit For
        End If
    End If
Next Cell

' определяем последнюю значимую строку второй таблицы (последняя строка, в первой колонке которой есть значение)
For Each Cell In sheet2.Range("A:A")
    If Cell.Row > 2 Then
        If Cell.Value > "" Then
            last_j = Cell.Row
        Else
            Exit For
        End If
    End If
Next Cell

' пробегаем по строкам второй таблицы (внешний цикл)
For j = 3 To last_j
    ' определяем идентификатор текущей строки
    str2 = sheet2.Cells(j, 1).Value & "-" & sheet2.Cells(j, 2).Value & "-" & sheet2.Cells(j, 3).Value & "-" & sheet2.Cells(j, 4).Value
    ' пробегаем по строкам первой таблицы (внутренний цикл)
    For i = 3 To last_i
        ' определяем идентификатор текущей строки
        str1 = sheet1.Cells(i, 1).Value & "-" & sheet1.Cells(i, 2).Value & "-" & sheet1.Cells(i, 3).Value & "-" & sheet1.Cells(i, 4).Value
        ' сравниваем идентификаторы строк первой и второй таблицы
        If str2 = str1 Then
            ' если совпадение найдено, то записываем покупателя из второй таблицы в первую в строку с соответствующей ему квартирой
            sheet1.Cells(i, 5).Value = sheet2.Cells(j, 5).Value
            ' прекращаем внутренний цикл, переходим к следующей итерации внешнего цикла
            ' (к следующей записи второй таблицы)
            Exit For
        End If
    Next i
Next j

End Sub

Результат решения задачи:
результат сравнения таблиц в Excel

Другие интересные статьи

  • Как сравнить две таблицы в Excel с использованием формул?
  • Горячие клавиши Excel

Тэги: 

  • Статьи
  • Excel
  • сравнение таблиц
  • VBA
  • макросы

Понравилась статья? Поделить с друзьями:
  • Excel vba как сравнить диапазоны
  • Excel vba как создать форму ввода
  • Excel vba как создать новую книгу с именем
  • Excel vba как снять фильтр
  • Excel vba как снять объединение ячеек