在一个dynamic范围内有条件地计算一行中某些单元格的最大（即最大数量）

我正在尝试创build一个macros，它将查找行中特定列的最大值（即最大值）。

图1：

例如，在图1中，我展示了一个范围从A1到K12的简单示例表。 前两排分别代表“高度”和“年份”。 他们总是从小到大 这个数字显示了2年的数据，我正在尝试创造年间之间每个高度的最大值。 我用红色文字突出显示我正在尝试做什么。 例如，单元格L3是B3和G3的最大值（即= MAX（B3，G3）），类似地，范围L3的所有单元格：红色的P12是每个高度的最大值。 我知道我可以通过使用Max（cell1，cell2）函数或使用下面的macros手动计算来轻松完成此操作：

Sub test() Range("G1").Select Range(Selection, Selection.End(xlToRight)).Select Selection.Copy Range("L1").Select ActiveSheet.Paste Range("L3").Select Application.CutCopyMode = False ActiveCell.FormulaR1C1 = "=MAX(RC[-10],RC[-5])" Range("L3").Select Selection.AutoFill Destination:=Range("L3:P3"), Type:=xlFillDefault Range("L3:P3").Select Selection.AutoFill Destination:=Range("L3:P12") Range("L3:P12").Select End Sub 

但是，我的实际表格是更多的数据更多的年份，更高的数据，我将运行在许多电子表格的循环。 那里的行数和列数可以有所不同。 所以我只是想知道如何采用一个dynamic的参数来dynamic计算最高两行（即高度和年份）的最大值。 我在考虑是否可以设置一个范围，因为高度会一直增加，直到下一年再次从最低值开始。 我的计划是，然后尝试把一些条件来计算最大值，并自动填充范围。 但是我只是无法定义范围，因为我正在努力逻辑规划这个代码。 以下是我已经尝试过，我真的很感激任何指导如何在逻辑上我可以实现这个问题。 提前谢谢了！

 Sub test() Dim LR As Long, i As Long, r As Range LR = Range("1" & Columns.Count).End(xlToRight) For i = 1 To LR If Range("1" & i).Value > 10 Then If r Is Nothing Then Set r = Range("1" & i) Else Set r = Union(r, Range("1" & i)) End If End If Next i r.Select End Sub 

Answer 1

由于身高值的可能性是无限的，所以使用class级是我现在可以想到的最好的解决scheme。 希望这为我们打下了良好的基础。

在名为“HeightClass”的类模块中：

 Option Explicit Dim rngRangeStore As Range Dim sValueStore As String Public Property Set rngRange(rngInput) Set rngRangeStore = rngInput End Property Public Property Get rngRange() As Range Set rngRange = rngRangeStore End Property Public Property Let sValue(sInput As String) sValueStore = sInput End Property Public Property Get sValue() As String sValue = sValueStore End Property 

然后在一个标准模块中：

 Option Explicit Sub Get_Max() Dim lRecord As Long, lRange As Long, lLastRecord As Long, lLastColumn As Long Dim colRanges As New Collection Dim clsRange As HeightClass 'Find Last used column in the year row lLastColumn = Rows(2).Find(What:="*", SearchDirection:=xlPrevious).Column 'Find last used row in column 1 lLastRecord = Columns(1).Find(What:="*", SearchDirection:=xlPrevious).Row For lRange = 2 To lLastColumn On Error Resume Next Set clsRange = Nothing Set clsRange = colRanges(Trim$(Cells(1, lRange).Value)) On Error GoTo 0 If Not clsRange Is Nothing Then 'Add to existing range Set clsRange.rngRange = Union(clsRange.rngRange, Cells(1, lRange)) Else 'Add range to colletion in order of smallest to largest Set clsRange = New HeightClass Set clsRange.rngRange = Cells(1, lRange) clsRange.sValue = Cells(1, lRange).Value If colRanges.Count = 0 Then colRanges.Add Item:=clsRange, Key:=clsRange.sValue Else For lRecord = 1 To colRanges.Count If clsRange.sValue < colRanges(lRecord).sValue Then colRanges.Add Item:=clsRange, Key:=clsRange.sValue, Before:=colRanges(lRecord).sValue Exit For ElseIf lRecord = colRanges.Count Then colRanges.Add Item:=clsRange, Key:=clsRange.sValue, After:=colRanges(lRecord).sValue Exit For End If Next lRecord End If End If Next lRange 'Place height headers For lRange = 1 To colRanges.Count With Cells(1, lLastColumn + lRange) .Value = colRanges(lRange).sValue .Font.Color = vbRed End With Next lRange 'Process each record For lRecord = 3 To lLastRecord For lRange = 1 To colRanges.Count With Cells(lRecord, lLastColumn + lRange) .Value = Application.Max(colRanges(lRange).rngRange.Offset(lRecord - 1)) .Font.Color = vbRed .NumberFormat = "0.00" End With Next lRange Next lRecord End Sub 

这是写在执行所需的过程中的任何表格焦点。

Answer 2

所以数组公式（在Ctrl + Shift + Enter中input ）版本会在L3等：

 =MAX(IF($B$1:$K$1=L$1,$B3:$K3,"")) 

它说：

• 查看标题$B$1:$K$1查看列高（ =L$1 ）
• 如果匹配，则取值,$B3:$K3
• 否则忽略它,""
• 取那些不被忽略的值的MAX

我试了100列（5高度* 20年）和1000行RAND产生随机数，重新计算时间可以忽略不计