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

本文介绍了如何根据特定条件找到范围内的最大值?的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

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

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.