Последние записи

made in programmersforum 6

Интенсив по Python: Работа с API и фреймворками 24-26 ИЮНЯ 2022. Знаете Python, но хотите расширить свои навыки?
Slurm подготовили для вас особенный продукт! Оставить заявку по ссылке - https://slurm.club/3MeqNEk

Online-курс Java с оплатой после трудоустройства. Каждый выпускник получает предложение о работе
И зарплату на 30% выше ожидаемой, подробнее на сайте академии, ссылка - ttps://clck.ru/fCrQw

17th
Мар

Cравнить 2 списка в Excel на отличия

Posted by obzor under VBA

Как быстро сравнить 2 диапазона данных на НЕСОВПАДЕНИЯ?

Всего в обработке события должно участвовать 4 столбца. 2 на странице с данными и 2 на странице библиотекой.

Если данные по ключу NUMBER на вкладке DATA отличаются во вкладке CHECK, то вывести msgbox с перечисленными полями NUMBER где есть расхождения, если данные идентичны, то вывести msgbox OK.

Формулой через ВПР это легко реализуется, но очень хочется разобраться как сделать это одним кликом. Причем столбцы могут содержать пробелы…

Aleksandr H.

Я так бы делал, наверное.

Код:


Function VPR(rngWhat As Range, rngWhere As Range)
    Dim numberWhat As String, codeWhat
    Dim numberWhere As String, codeWhere, colWhere As Long
    Dim r As Long, s As String
    s = ""
    For r = 1 To rngWhat.Rows.Count
        numberWhat = rngWhat.Cells(r, 1)
        codeWhat = rngWhat(r, rngWhat.Columns.Count)
        On Error Resume Next
        codeWhere = Application.WorksheetFunction.VLookup
            (numberWhat, rngWhere, rngWhere.Columns.Count, 0)
        If Err.Number = 0 Then
            If codeWhat <> codeWhere Then
                s = s & numberWhat & vbNewLine
            End If
        End If
        On Error GoTo 0
    Next r
    If s <> "" Then
        VPR = s
    Else
        VPR = "OK"
    End If
End Function

Sub test()
    MsgBox (VPR(Range("Data!C2:K18"), Range("CHECK!A2:B20")))
End Sub

Дебажте, рефактурируйте, ищите/ждите лучшие предложения.

IgorGO

или так:

Код:


Function VPR$(rngWhat As Range, rngWhere As Range)
    Dim c As Range
    For Each c In rngWhat
      If WorksheetFunction.CountIf(rngWhere, c) = 0 Then VPR = VPR & " " & c
    Next
    If VPR = "" Then VPR = "Ok"
End Function

Sub test()
    MsgBox (VPR(Range("Data!C2:C18"), Range("CHECK!A2:A9")))
End Sub

Hugo121

Проще использовать словарь и коллекцию для результатов.

Код:


Option Explicit

Sub tt()
    Dim a, b, i&, col As New Collection
    With Sheets("DATA")
        a = .[c1].CurrentRegion.Value
        b = .[c1].CurrentRegion.Offset(, 8).Value
    End With
    With CreateObject("scripting.dictionary"): .comparemode = 1
        For i = 2 To UBound(a): .Item(a(i, 1)) = b(i, 1): Next
        a = Sheets("CHECK").[a1].CurrentRegion.Value
        For i = 2 To UBound(a)
            If .Item(a(i, 1)) <> a(i, 2) Then col.Add a(i, 1)
        Next
    End With

    'вывод результат делайте как хотите
    Dim el
    For Each el In col
        MsgBox "Расхожение в ключе " & el
    Next

End Sub