Макрос для сравнения ячеек 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

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

wtftaekwondo

0 / 0 / 0

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

Сообщений: 15

1

06.09.2019, 16:26. Показов 12357. Ответов 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

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

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

  • Как сравнить две таблицы в 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
  • макросы

Операторы сравнения чисел и строк, ссылок на объекты (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 вот код:

Код
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 задавать новые адреса верхних углов перемещенных диапазонов

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 оч хочется тебя отблагодарить!

 

Ответить

Понравилась статья? Поделить с друзьями:
  • Макрос для сравнения двух столбцов excel
  • Макрос для списка на листе excel
  • Макрос для сохранения файла excel в папку
  • Макрос для сохранения файла excel в pdf
  • Макрос для сохранения одного листа excel