Блог

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

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

 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" amp; 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" amp; LastRowDestA   1)

    End If

End Sub
  

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

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

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

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

Я предлагаю создать 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) amp; " " amp; dbArea(i, 2) amp; " " amp; 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) amp; " " amp; newDataArea(i, 2) amp; " " amp; 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
  

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