Проверьте, существует ли набор данных в текущем рабочем листе.

Question

У меня есть большая таблица, заполненная данными.То, что я хочу сделать, это проверить, существует ли набор данных в этой таблице.Я вставил нужные данные в отдельную таблицу.Диапазон с элементами таблицы, которые я ищу, называется "SearchedData", а область, в которой я проверяю, хранятся ли данные, которые я ищу, называется "SearchArea".

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

Sub CheckWetherDataExists()

    Dim SearchedData As Variant
    Dim SearchArea As Variant

    SearchedData = ThisWorkbook.Worksheets("Tabelle2").Range("C5:G8").Value
    SearchArea = ThisWorkbook.Worksheets("Tabelle1").Range("A:E").Value

    If SearchArea = SearchedData Then
    MsgBox ("Searched Data already exists")

    Else: MsgBox ("Searched Data is missing")
    End If


End Sub

Answer 1

Я полагаю, что этот код будет делать то, что вам нужно, достаточно быстро.

Sub CheckWetherDataExists()

    Dim SearchedData As Variant
    Dim SearchArea As Variant
    Dim LookFor() As String
    Dim LookIn() As String
    Dim R As Long, C As Long

    SearchedData = ThisWorkbook.Worksheets("Tabelle2").Range("C5:G8").Value
    LookFor = MergedRows(SearchedData)

    With ThisWorkbook.Worksheets("Tabelle1")
        SearchArea = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp)).Value
    End With
    LookIn = MergedRows(SearchArea)

    For R = 1 To UBound(LookIn)
        If LookIn(R) = LookFor(1) Then
            If R < UBound(LookIn) - 2 Then
                For C = 2 To UBound(LookFor)
                    If LookIn(R + C - 1) <> LookFor(C) Then Exit For
                Next C
                If C > UBound(LookFor) Then
                    MsgBox "Match found in Row " & R
                    Exit For
                End If
            End If
        End If
    Next R
End Sub

Private Function MergedRows(RngVal As Variant) As String()

    Dim Fun() As String
    Dim R As Long, C As Long

    ReDim Fun(1 To UBound(RngVal))

    For R = 1 To UBound(RngVal)
        For C = 1 To UBound(RngVal, 2)
            Fun(R) = Fun(R) & "," & RngVal(R, C)
        Next C
    Next R
    MergedRows = Fun
End Function

Код создает объединенные строки из 5 ячеек данных SearchedData и SearchArea.Эта работа выполняется функцией MergedRows .В процессе SearchedData превращаются в массив LookFor (1 - 3) и LookIn (1 - LastRow).Затем первый элемент (представляющий строку) LookFor сравнивается с каждым элементом (представляющим строку) LookIn.Если совпадение найдено, две другие строки также сравниваются.Когда все три элемента (строки) совпадают, выдается сообщение и поиск прекращается.

Answer 2

Это более сложный способ решения.

Представьте себе Tabelle2 следующим образом:

И Tabelle1следующим образом:

Я предлагаю использовать метод Range.Find , чтобы найти первое вхождение данных первых ячеек здесьэто представлено 11.И затем проверьте, правильно ли остальные данные ниже / там тоже.Делайте это в цикле, пока все случаи не будут проверены.

Так что в Tabelle1 желтые области будут проверены, но единственное полное совпадение - A14:E17, что будет считаться дубликатом.

Option Explicit

Public Sub CheckIfDataExists()
    Dim wsSearch As Worksheet
    Set wsSearch = ThisWorkbook.Worksheets("Tabelle1")

    Dim SearchRange As Range
    Set SearchRange = wsSearch.Range("A1", wsSearch.Cells(wsSearch.Rows.Count, "A").End(xlUp))

    Dim SearchData() As Variant 'data array
    SearchData = ThisWorkbook.Worksheets("Tabelle2").Range("C5:G8").Value

    Dim FoundData() As Variant

    'remember first find to prevent endless loop
    Dim FirstFoundAt As Range
    Set FirstFoundAt = SearchRange.Find(What:=SearchData(1, 1), After:=SearchRange.Cells(1, 1), LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)

    If Not FirstFoundAt Is Nothing Then
        Dim FoundAt As Range
        Set FoundAt = FirstFoundAt
        Do
            Set FoundAt = SearchRange.Find(What:=SearchData(1, 1), After:=FoundAt, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
            If Not FoundAt Is Nothing Then
                FoundAt.Resize(UBound(SearchData, 1), UBound(SearchData, 2)).Select
                FoundData = FoundAt.Resize(UBound(SearchData, 1), UBound(SearchData, 2)).Value
                If AreArraysEqual(SearchData, FoundData) Then
                    MsgBox "data found at " & FoundAt.Resize(UBound(SearchData, 1), UBound(SearchData, 2)).Address
                    Exit Sub
                End If
            End If
        Loop Until FoundAt Is Nothing Or FirstFoundAt.Row >= FoundAt.Row
    End If

    MsgBox "data not found"
End Sub

Private Function AreArraysEqual(Arr1 As Variant, Arr2 As Variant) As Boolean
    Dim iRow As Long, iCol As Long

    'default
    AreArraysEqual = True

    For iRow = LBound(Arr1, 1) To UBound(Arr1, 1)
        For iCol = LBound(Arr1, 2) To UBound(Arr1, 2)
            If Arr1(iRow, iCol) <> Arr2(iRow, iCol) Then
                AreArraysEqual = False
                Exit Function
            End If
        Next iCol
    Next iRow
End Function