Сравнить ячейки excel макрос

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

Excel для Microsoft 365 Excel для Microsoft 365 для Mac Excel 2021 Excel 2021 для Mac Excel 2019 Excel 2019 для Mac Excel 2016 Excel 2016 для Mac Excel 2013 Office для бизнеса Excel 2010 Excel 2007 Еще…Меньше

Чтобы сравнить данные в двух столбцах Microsoft Excel и найти повторяющиеся записи, воспользуйтесь следующими способами. 

Способ 1. Использование формулы на этом этапе

  1. Начните Excel.

  2. На новом примере введите следующие данные (оставьте столбец B пустым):

    A

    B

    C

    1

    1

    3

    2

    2

    5

    3

    3

    8

    4

    4

    2

    5

    5

    0

  3. Введите в ячейку B1 следующую

    формулу:=IF(ISERROR(MATCH(A1,$C$1:$C$5,0)),»»,A1)

  4. Выберем ячейку С1 по B5.

  5. В Excel 2007 и более поздних версиях Excel выберите Заполнить в группе Редактирование, а затем выберите Вниз.

    Повторяющиеся числа отображаются в столбце B, как в следующем примере: 

    A

    B

    C

    1

    1

    3

    2

    2

    2

    5

    3

    3

    3

    8

    4

    4

    2

    5

    5

    5

    0

Способ 2. Использование макроса Visual Basic макроса

Предупреждение: Корпорация Майкрософт предоставляет примеры программирования только для иллюстрации без гарантии, выраженной или подразумеваемой. Это относится и не только к подразумеваемой гарантии пригодности и пригодности для определенной цели. В этой статье предполагается, что вы знакомы с языком программирования, который демонстрируется, и средствами, используемыми для создания и от debug procedures. Инженеры службы поддержки Майкрософт могут объяснить функциональные возможности конкретной процедуры. Однако они не будут изменять эти примеры, чтобы обеспечить дополнительные функциональные возможности или процедуры по построению в необходимом порядке.

Чтобы использовать макрос Visual Basic для сравнения данных в двух столбцах, с помощью следующих действий:

  1. Запустите Excel.

  2. Нажмите ALT+F11, чтобы запустить Visual Basic редактора.

  3. В меню Вставка выберите Модуль.

  4. Введите следующий код на листе модуля:

    Sub Find_Matches()
    Dim CompareRange As Variant, x As Variant, y As Variant
    ' Set CompareRange equal to the range to which you will
    ' compare the selection.
    Set CompareRange = Range("C1:C5")
    ' NOTE: If the compare range is located on another workbook
    ' or worksheet, use the following syntax.
    ' Set CompareRange = Workbooks("Book2"). _
    ' Worksheets("Sheet2").Range("C1:C5")
    '
    ' Loop through each cell in the selection and compare it to
    ' each cell in CompareRange.
    For Each x In Selection
    For Each y In CompareRange
    If x = y Then x.Offset(0, 1) = x
    Next y
    Next x
    End Sub

  5. Нажмите ALT+F11, чтобы вернуться к Excel.

    1. Введите в качестве примера следующие данные (оставьте столбец B пустым):
       

      A

      B

      C

      1

      1

      3

      2

      2

      5

      3

      3

      8

      4

      4

      2

      5

      5

      0

  6. Выберем ячейку от A1 до A5.

  7. В Excel 2007 и более поздних версиях Excel выберите вкладку Разработчик, а затем в группе Код выберите макрос.

    Примечание: Если вкладка Разработчик не отключается, возможно, ее нужно включить. Для этого выберите Файл > параметры > настроитьленту , а затем выберите вкладку Разработчик в поле настройки справа.

  8. Щелкните Find_Matches, а затем нажмите кнопку Выполнить.

    Повторяющиеся числа отображаются в столбце B. Совпадающие числа будут поместиться рядом с первым столбцом, как показано ниже.

    A

    B

    C

    1

    1

    3

    2

    2

    2

    5

    3

    3

    3

    8

    4

    4

    2

    5

    5

    5

    0

Нужна дополнительная помощь?

Переместила кнопку на активный лист, так удобнее.
Если нужно обязательно, чтоб кнопка была на Листе2 вот код:

Код
Sub DiffsColor()
'допускаем наличие пустых ячеек в середине  и конце диапазонов

'x = адрес верхней ячейки первого сравниваемого диапазона = значению в ячейке B2 на Лист2
'y = адрес верхней ячейки второго сравниваемого диапазона = значению в ячейке B3 на Лист2

x = ThisWorkbook.Sheets("Лист2").Range("B2")
y = ThisWorkbook.Sheets("Лист2").Range("B3")

xCol = Worksheets("Лист1").Range(x).Column 'колонка первого диапазона
xRow = Worksheets("Лист1").Range(x).Row 'строка начала первого диапазона
yCol = Worksheets("Лист1").Range(y).Column 'колонка второго диапазона
yRow = Worksheets("Лист1").Range(y).Row 'строка начала второго диапазона


xLastRow = Worksheets("Лист1").Cells(Rows.Count, xCol).End(xlUp).Row 'последняя строка первого диапазона
yLastRow = Worksheets("Лист1").Cells(Rows.Count, yCol).End(xlUp).Row 'последняя строка второго диапазона

MaxLastRow = Application.WorksheetFunction.Max(xLastRow - xRow + 1, yLastRow - yRow + 1)


Set lastcell = Worksheets("Лист1").Cells(MaxLastRow + 1, xCol)

Dim c As Range
'прогоняем сравнение от начальной заданной ячейки x до последней ячейки в этом столбце
For Each c In Worksheets("Лист1").Range(x, lastcell)
    If c.Value <> Worksheets("Лист1").Cells(yRow, yCol) Then
    c.Interior.ColorIndex = 42
    Worksheets("Лист1").Cells(yRow, yCol).Interior.ColorIndex = 42
    End If
    yRow = yRow + 1
Next c

End Sub

Когда перемещаете диапазоны, не забывайте на Листе2 задавать новые адреса верхних углов перемещенных диапазонов

wtftaekwondo

0 / 0 / 0

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

Сообщений: 15

1

06.09.2019, 16:26. Показов 12374. Ответов 10

Метки нет (Все метки)


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

Всем привет!
Стоит задача, чтобы сравнить две ячейки на содержимое: если в 1 ячейке имеется слово из другой ячейки, то необходимо справа от него записать это слово.
У меня получается решение данной задачи, если сравнивать , образно, 500 строк с одним словом и записывать его, если оно есть.
Однако мне требуется сравнить 500 строк с 50 словами и , в случае совпадения, записать это слово.
Вот пример успешного решения для 1 слова — «Труба».
Необходимо, чтобы InStr сравнивал ячейку не со словом «Труба», а с массивом «Celevye» в котором я запишу необходимые для присвоения слова.

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub reshen()
    Dim i As Integer
    Dim value As String
    Dim Celevye As Variant
    Dim TotalRows As Long
    Dim N As Integer
    TotalRows = Rows(Rows.Count).End(xlUp).Row
    Celevye = Array("Труба", "Гвоздь")
    N = 500
    Z = 50
            For j = 1 To Z
                For i = 1 To N
                    If InStr(1, Cells(i, 2), "Труба") <> 0 Then
                    Cells(i, 3) = "Труба"
                End If
                Next i
            Next j
End Sub



0



4131 / 2235 / 940

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

Сообщений: 4,624

06.09.2019, 17:34

2

wtftaekwondo, Как говорится, меньше слов, а больше дел В общем, лучше приложите небольшой фрагмент таблиц, 1) что есть и 2) что должно получиться, после выполнения макроса.



0



0 / 0 / 0

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

Сообщений: 15

06.09.2019, 17:56

 [ТС]

3

Хорошо. Вот две фотографии (пример).
Под колонкой F написаны слова, которые должны находиться в колонке «B».
В случае, если это слово содержится в ячейке, то справа оно должно записаться.

Миниатюры

Сравнение значений ячеек в Excel
 

Сравнение значений ячеек в Excel
 



0



4131 / 2235 / 940

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

Сообщений: 4,624

06.09.2019, 18:06

4

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

Но даже без файла возникает вопрос, почему ‘направляющая верхняя’ это просто ‘направляющая’, а ‘направляющая втулка’ это уже ‘направляющая монтажная’. В списке искомых наличествует только ‘направляющая’, возможно монтажной просто не видно…



0



0 / 0 / 0

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

Сообщений: 15

06.09.2019, 18:18

 [ТС]

5

За последние 2 строки извиняюсь, это идеальный вариант, которые уже обрабатывается вручную.
Необходимо просто получить «Направляющая».
Просто хотел побыстрее скинуть AS IS и TO BE поэтому не проверил.
Суть в том, чтобы третий столбец принял одно из значений массива из целевых слов (в моем примере их 3 слова).



0



4131 / 2235 / 940

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

Сообщений: 4,624

06.09.2019, 18:33

6

Вариант с помощью формулу подойдёт ?

Код

=ИНДЕКС($F$1:$F$3;ПОИСКПОЗ(1;(СЧЁТЕСЛИ(B1;$F$1:$F$3&"*"));0))



1



0 / 0 / 0

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

Сообщений: 15

06.09.2019, 18:45

 [ТС]

7

В целом тоже подойдет, спасибо)
Но если кто-то сталкивался с макросами и ему это будет знакомо, то хотелось бы еще и в VBA сделать.



0



pashulka

4131 / 2235 / 940

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

Сообщений: 4,624

06.09.2019, 21:31

8

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

Решение

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub Test()
    Dim a1, a2, t, i1&, i2&
    a1 = Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value
    a2 = Range("F1:F3").Value
    For i1 = 1 To UBound(a1)
        t = a1(i1, 1): a1(i1, 1) = Empty
        For i2 = 1 To 3
            If InStr(1, t, a2(i2, 1), vbTextCompare) = 1 Then
               a1(i1, 1) = a2(i2, 1)
               Exit For
            End If
        Next
    Next
    Range("C1").Resize(i1 - 1) = a1
End Sub

Или просто программно ввести вышеопубликованную формулу
правда в той формуле наличествуют лишние(ненужные) скобки для счётесли

Альтернативные варианты

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub Test2v1()
    Dim a1, a2, t, i&
    a1 = Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value
    a2 = Range("F1:F3").Value
    For i = 1 To UBound(a1)
        t = Split(a1(i, 1))(0): a1(i, 1) = Empty
        If Not IsError( _
        Application.Match(t, a2, 0)) Then a1(i, 1) = t
    Next
    Range("C1").Resize(i - 1) = a1
End Sub
Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Sub Test2v2()
    Dim r As Range, a, t, i&
    a = Range("B1", Cells(Rows.Count, "B").End(xlUp)).Value
    Set r = Range("F1:F3")
    For i = 1 To UBound(a)
        t = Split(a(i, 1))(0): a(i, 1) = Empty
        If Application.CountIf(r, t) > 0 Then a(i, 1) = t
    Next
    Range("C1").Resize(i - 1) = a
End Sub



1



wtftaekwondo

0 / 0 / 0

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

Сообщений: 15

09.09.2019, 12:16

 [ТС]

9

Если не сложно, то сможете прокомментировать или объяснить данные строки:

Visual Basic
1
2
3
t = Split(a(i, 1))(0): a(i, 1) = Empty
If Application.CountIf(r, t) > 0 Then a(i, 1) = t
Range("C1").Resize(i - 1) = a



0



4131 / 2235 / 940

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

Сообщений: 4,624

09.09.2019, 13:01

10

получаем первое слово(слово=любой набор символов): «очищаем» элемент массива
countif та же функция рабочего листа счётесли
заполняем диапазон, начиная с ячейки C1 и закачивая C & i-1 (в данном конкретном случае, можно написать «C1:C» & i-1) элементами массива a

пользуйтесь клавишей F1



0



0 / 0 / 0

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

Сообщений: 21

13.09.2019, 13:51

11

Много вариантов, конечно



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

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