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

同样，我没有测试此代码，因为我无法访问您的数据格式，但是希望它将使您更进一步地找到可行的解决方案。

如何根据特定条件找到范围内的最大值？

1 个答案: