Как найти максимальное значение в диапазоне на основе определенных условий?

Question

У меня есть лист со списком футбольных матчей и соответствующими данными. Каждую неделю я загружаю новые данные о совпадениях с веб-сайта, выбираю все новые совпадения и добавляю эти строки на лист, а затем копирую несколько формул из столбцов, которые есть только на моем листе и не являются частью загруженного листа.

Я собрал приведенный ниже код для импорта данных, соединив здесь сообщения и другие форумы:

Sub FD_new()

Dim rngLeague As Range
Dim cell As Range
Dim copiedRange As Range
Dim r As Integer
Dim LastRowSrc As Long
Dim LastRowDestA As Long
Dim DestWS As Worksheet
Dim DestWB As Workbook
Dim MaxDate As long

Set DestWB = Workbooks("Master Sheet")
Set DestWS = DestWB.Worksheets("Sheet1")

MaxDate = DateValue("03/03/2019")

    'Build selected range to copy from dowload sheet
    LastRowSrc = Cells(Rows.Count, "A").End(xlUp).Row

    r = 0

    Set rngLeague = Range("C2:C" & LastRowSrc)

    For Each cell In rngLeague
        If DateValue(cell) > MaxDate Then
            If r = 0 Then
                Set copiedRange = Range(cell.Offset(0, -2), cell.Offset(0, 11))
                r = 1
            Else
                Set copiedRange = Union(copiedRange, Range(cell.Offset(0, -2), cell.Offset(0, 11)))
            End If
        End If
    Next cell

    'Copy and paste range once finished
    If r = 1 Then

        LastRowDestA = DestWS.Cells(Rows.Count, "A").End(xlUp).Row

        copiedRange.Copy DestWS.Range("A" & LastRowDestA + 1)

    End If

End Sub

Однако сложность заключается в том, что в листе для загрузки иногда отсутствуют последние данные для всех лиг - некоторые обновляются ежедневно, а некоторые - каждые 2-3 дня. Это означает, что в ручном режиме я должен проверить свой мастер-лист на самую последнюю дату матча для каждой лиги, перейти на лист загрузки, выбрать все матчи для этой лиги, которые после этой даты, и скопировать. Следовательно, я не могу просто использовать одну MaxDate (как в коде выше).

Так что я думаю, что мне нужно обновить мой код: - определить самую последнюю дату матча по лиге в мастер-листе - определить все самые последние матчи для этой лиги в листе загрузки - скопируйте их на мастер лист - повторить для всех лиг

Конечно, может быть более простой способ сделать это!

Я думаю, мне нужно создать массив (или массивы) лиг и дат, но, если честно, я запутался.

Answer 1

Я предлагаю создать Dictionary из ваших существующих данных, чтобы проверить, действительно ли сканируемые «новые» данные являются новыми или являются повторением данных, которые у вас уже есть. Это нерабочий пример (потому что у меня нет ваших столбцов базы данных), но он иллюстрирует метод.

Сначала в меню VBEперейдите в Инструменты -> Ссылки ... и добавьте библиотеку «Microsoft Scripting Runtime» в ваш проект.

Затем создайте функцию, которая создаст Dictionary из ваших существующих данных партитуры.Это может выглядеть примерно так:

Function BuildDictionary() As Dictionary
    Dim dbWS As Worksheet
    Dim dbRange As Range
    Dim dbArea As Variant
    Set dbWS = ThisWorkbook.Sheets("MasterSheet")
    Set dbRange = dbWS.Range("A1:Z20")  'this should be dynamically calc'ed
    dbArea = dbRange                    'copied to memory array

    Dim dataDict As Dictionary
    Set dataDict = New Dictionary

    Dim i As Long
    For i = LBound(dbArea, 1) To UBound(dbArea, 1)
        Dim uniqueKey As String
        '--- combine several fields to create a unique identifier for each
        '    game:  Date+League+Teams
        uniqueKey = dbArea(i, 1) & "+" & dbArea(i, 2) & "+" & dbArea(i, 3)
        If Not dataDict.Exists(uniqueKey) Then
            dataDict.Add uniqueKey, i              'stores the row number
        End If
    Next i
    Set BuildDictionary = dataDict
End Function

Теперь в вашей основной логике вы возьмете этот созданный словарь и воспользуетесь им, чтобы проверить, существуют ли ваши новые данные в ваших данных основного листа:

Option Explicit

Sub ProcessNewData()
    Dim existingData As Dictionary
    Set existingData = BuildDictionary

    '--- loop over your new data sheet and create a "key" from the
    '    new data fields
    Dim newDataRange As Range
    Dim newDataArea As Variant
    Set newDataRange = ThisWorkbook.Sheets("NewDataSheet").Range("A1:Z20")
    newDataArea = newDataRange

    Dim i As Long
    For i = LBound(newDataArea, 1) To UBound(newDataArea, 1)
        Dim newKey As String
        '--- build a key using the same fields in the same format
        newKey = newDataArea(i, 1) & "+" & newDataArea(i, 2) & "+" & newDataArea(i, 3)
        If Not existingData.Exists(newKey) Then
            '--- add a new row of data to your master sheet data here and
            '    transfer from the newDataArea to the sheet
        End If
    Next dataRow
End Sub

Опять же, я не тестировал этот код, потому что у меня нет доступа к вашим форматам данных, но, надеюсь, он продвинет вас дальше по пути к работающему решению.