如何根据特定条件找到范围内的最大值? [英] How to find max value in range based on certain conditions?

问题描述

我有一张工作表，上面列出了足球比赛和相关数据.每周我都会从网站上下载新的匹配数据，选择所有新匹配并将这些行添加到工作表中，然后从仅在我的工作表中而不是已下载工作表的一部分的列中复制一些公式.

I have a sheet with a list of football matches and associated data. Each week I download new match data from a website, select all the new matches and add these rows to the sheet and then copy a few formulas down from columns that are only in my sheet and not part of the downloaded sheet.

我通过将来自此处和其他论坛的帖子拼接在一起，为导入数据构建了以下代码:

I've built the below code for the data import by stitching together posts from here and other forums:

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(如上面的代码所示).

However, where it gets complicated is that the download sheet sometimes doesn't have the latest data for all leagues - some are updated on a daily basis, some every 2-3 days. This means in manual mode I have to check my master sheet for the most recent match date for each league, go to the download sheet, select all the matches for this league that are after this date and copy across. Consequently I can't just use one MaxDate (as in above code).

所以我认为我需要将代码更新为:-在主表中按联赛确定最近的比赛日期-在下载表中找到该联赛的所有最新比赛-将这些复制到主表-对所有联赛重复

So I think I need to update my code to: - identify the most recent match date by league in the master sheet - identify all the most recent matches for that league in the download sheet - copy these across to the master sheet - repeat for all the leagues

当然，可能有更简单的方法！

Of course there may be a simpler way to do it!

我认为我需要创建一个或多个联赛和日期数组，但是老实说，我完全感到困惑.

I think I need to create an array (or arrays) of leagues and dates, but if I'm honest I got totally confused.

推荐答案

我的建议是从您现有的数据中创建一个 Dictionary ，以便检查所扫描的新"数据是否确实是新的或者是您已经拥有的数据的重复. 这是一个不起作用的示例(因为我没有您的数据库列)，但是它说明了该方法.

My suggestion is to create a Dictionary from your existing data in order to check if the "new" data being scanned is truly new or is a repeat of data you already have. This is a non-working example (because I don't have your database columns), but it illustrates the method.

首先，在VBE菜单中，转到工具"->参考..."，然后将"Microsoft Scripting Runtime"库添加到您的项目中.

First, in the the VBE menu go to Tools-->References... and add the "Microsoft Scripting Runtime" library to your project.

然后，创建一个函数，该函数将根据您现有的得分数据创建一个 Dictionary .看起来可能像这样:

Then, create a function that will create a Dictionary from your existing score data. It could looks something like this:

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

现在，在您的主要逻辑中，您将使用此创建的字典并将其用于检查您的主表数据中是否已经存在新数据:

Now, in your main logic you will take this created dictionary and use it to check if your new data already exists in your master sheet data:

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

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

Again, I haven't tested this code because I don't have access to your data formats, but it will hopefully push you farther down the path to a working solution.

这篇关于如何根据特定条件找到范围内的最大值?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！