Question

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

图1：

enter image description here

例如，在图1中，我展示了一个范围从A1到K12的简单示例表。前2行分别代表“高度”和“年份”。它们总是按升序排列。该图显示了2年的数据，我正在尝试为年份之间的每个高度创建最大值。我用红色文字突出显示了我要做的事情。例如，单元L3是B3和G3的最大值（即= MAX（B3，G3）），类似地，范围L3的所有单元格：红色的P12是每个高度的最大值。我知道只需通过使用Max（cell1，cell2）函数或使用以下宏手动计算，我就可以轻松完成此任务：

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

但是我的实际表格要大得多，随着更多年的数据有更多的高度，我将在许多电子表格的循环中运行它。行数和列数可以有所不同。所以我只是想知道如何采用动态参数，根据前两行（即高度和年份）动态计算最大值。我想是否有任何方法可以设置顶行的范围，因为高度将一直增加，直到第二年再次从最低值重新开始。我的计划是尝试设置一些条件来计算最大值并自动填充范围。但我甚至无法定义范围，因为我正在积极地计划这段代码。以下是我尝试过的内容，我非常感谢有关逻辑上如何实现此问题的任何指导。提前谢谢了！

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

由于高度值的无限可能性，使用类是我现在能想到的最佳解决方案。希望这为构建起来提供了良好的基础。

在名为＆＃39; HeightClass＆＃39;：

的课程模块中

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 输入）版本将是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产生的随机数，重新计算时间可以忽略不计

对于动态范围，有条件地计算一行中某些单元的最大值（即最大数量）

2 个答案: