Сравнение ячеек в excel на совпадения vba

2 / 2 / 0

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

Сообщений: 45

1

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

29.05.2012, 00:04. Показов 23546. Ответов 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

17993 / 7619 / 890

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

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

Записей в блоге: 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

17993 / 7619 / 890

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

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

Записей в блоге: 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

17993 / 7619 / 890

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

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

Записей в блоге: 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

17993 / 7619 / 890

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

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

Записей в блоге: 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

17993 / 7619 / 890

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

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

Записей в блоге: 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

17993 / 7619 / 890

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

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

Записей в блоге: 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

17993 / 7619 / 890

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

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

Записей в блоге: 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



I would like to compare 2 cells’ value and see whether they are match or not.
I know how to do it on excel but I dont’ know how to put it vba code.

Input & output:

  1. The value of cell A1 is already in the excel.
  2. Manually enter a value in Cell B1.
  3. click on a button_click sub to see whether the value on 2 cells are the same or not.
  4. Show «Yes» or «No» on cell C1

Excel formula:

=IF(A1=B1,"yes","no")

asked Jan 21, 2015 at 15:55

pexpex223's user avatar

Give this a try:

Sub CompareCells()
    If [a1] = [b1] Then
        [c1] = "yes"
    Else
        [c1] = "no"
    End If
End Sub

Assign this code to the button.

answered Jan 21, 2015 at 15:58

Gary's Student's user avatar

Gary’s StudentGary’s Student

95.3k9 gold badges58 silver badges98 bronze badges

1

If (Range("A1").Value = Range("B1").Value) Then
    Range("C1").Value = "Yes"
Else
    Range("C1").Value = "No"
End If

Chrismas007's user avatar

Chrismas007

6,0654 gold badges23 silver badges47 bronze badges

answered Jan 21, 2015 at 16:03

Eswin's user avatar

EswinEswin

292 bronze badges

5

You can use the IIF function in VBA. It is similar to the Excel IF

[c1] = IIf([a1] = [b1], "Yes", "No")

answered Jan 21, 2015 at 16:47

Paul Kelly's user avatar

Paul KellyPaul Kelly

9057 silver badges13 bronze badges

1

Here is an on change Sub (code MUST go in the sheet module). It will only activate if you change a cell in column B.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    If Target.Column <> 2 Then Exit Sub
    If Cells(Target.Row, 1).Value = Cells(Target.Row, 2).Value Then
        Cells(Target.Row, 3).Value = "Yes"
    Else
        Cells(Target.Row, 3).Value = "No"
    End If
End Sub

For the record, this doesn’t use a button, but it accomplishes your goal of calculating if the two cells are equal any time you manually enter data into cells in Col B.

answered Jan 21, 2015 at 16:08

Chrismas007's user avatar

Chrismas007Chrismas007

6,0654 gold badges23 silver badges47 bronze badges

Sub CompareandHighlight()
    Dim n As Integer
    Dim sh As Worksheets
    Dim r As Range

    n = Worksheets("Indices").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
    Application.ScreenUpdating = False 

    Dim match As Boolean
    Dim valE As Double
    Dim valI As Double
    Dim i As Long, j As Long

    For i = 2 To n
        valE = Worksheets("Indices").Range("E" & i).Value
        valI = Worksheets("Indices").Range("I" & i).Value

        If valE = valI Then

        Else:                           
            Worksheets("Indices").Range("E" & i).Font.Color = RGB(255, 0, 0)
        End If
    Next i

    Application.ScreenUpdating = True
End Sub

barbsan's user avatar

barbsan

3,39811 gold badges21 silver badges28 bronze badges

answered Nov 21, 2018 at 9:29

Madhushree's user avatar

0

If I understand your problem correctly, the following code should allow you to do what you want. Within the code, you select the range you wish to process; the first column of each data set, and the number of columns within each data set.

It does assume only two data sets, as you wrote, although that could be expanded. And there are ways of automatically determining the dataset columns, if there is no other data in between.

Option Explicit
Option Base 0
Sub RemoveDups()
    Dim I As Long, J As Long
    Dim rRng As Range
    Dim vRng As Variant, vRes() As Variant
    Dim bRng() As Boolean
    Dim aColumns, lColumns As Long
    Dim colRowsDelete As Collection

'vRng to include from first to last column to be tested
Set rRng = Range("f1", Cells(Rows.Count, "F").End(xlUp)).Resize(columnsize:=100)
vRng = rRng
ReDim bRng(1 To UBound(vRng))

'columns to be tested
'Specify First column of each data set
aColumns = Array(1, 13)

'num columns in each data set
lColumns = 3

For I = 1 To UBound(vRng)
    bRng(I) = vRng(I, aColumns(0)) = vRng(I, aColumns(1))
    For J = 1 To lColumns - 1
        bRng(I) = bRng(I) And (vRng(I, aColumns(0) + J) = vRng(I, aColumns(1) + J))
    Next J
Next I

'Rows to Delete
Set colRowsDelete = New Collection
For I = 1 To UBound(bRng)
    If bRng(I) = True Then colRowsDelete.Add Item:=I
Next I

'Delete the rows
If colRowsDelete.Count > 0 Then
Application.ScreenUpdating = False
    For I = colRowsDelete.Count To 1 Step -1
        rRng.Rows(colRowsDelete.Item(I)).EntireRow.Delete
    Next I
End If
Application.ScreenUpdating = True
End Sub

 

Gorr98

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

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

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

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

  • П3.xlsm (20.69 КБ)

 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 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

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

Сообщений: 23257
Регистрация: 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

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

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

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

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

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

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

 

Юрий М

Модератор

Сообщений: 60588
Регистрация: 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

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

Сообщений: 23257
Регистрация: 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
  • макросы

Like this post? Please share to your friends:
  • Сравнение ячеек в excel больше или равно
  • Сравнение числа с массивом excel
  • Сравнение числа в столбце excel
  • Сравнение чисел в ячейках excel
  • Сравнение чисел в таблице excel