相似值的最小值和最大值答案

【问题标题】：Minimum and Maxiumum of like values相似值的最小值和最大值
【发布时间】：2021-06-16 00:20:04
【问题描述】：

我正在尝试在多个集合中获取一个值范围，并编写一个 VBA 代码来用该范围内的最小值和最大值填充分组的单元格。

示例表

Group	Value
A	10
A	3
A	5
B	1
B	3

预期的输出应该是一个表格或单元格

A Range : 3-10
B Range : 1-3

显然，我可以对每个集合使用最小和最大公式来做到这一点，但是，我想知道在 VBA 中是否有办法做到这一点，因为集合的数量超过了几百个

【问题讨论】：

你可以使用MINIFS()和MAXIFS()

标签： excel vba

【解决方案1】：

您当然可以使用 VBA 和/或 Power Query 来做到这一点，尽管正如其他人所写并且您知道的那样，公式是一个可行的选择。

源数据

对于 VBA：

将源数据读入 VBA 数组以获得最快的处理速度
创建一个类模块来保存最小值和最大值
使用字典对范围进行分组，字典又包含类对象
创建一个结果数组并将其写入工作表。

类模块

'ReNAME this "cGroup"
Option Explicit
Private pMin As Long
Private pMax As Long

Public Property Get Min() As Long
    Min = pMin
End Property
Public Property Let Min(Value As Long)
    pMin = Value
End Property

Public Property Get Max() As Long
    Max = pMax
End Property
Public Property Let Max(Value As Long)
    pMax = Value
End Property

常规模块

'Set reference to Microsoft Scripting Runtime
Option Explicit
Sub generateRanges()
    Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
    Dim vSrc As Variant, vRes As Variant, v As Variant
    Dim I As Long
    Dim D As Dictionary, sKey As String
    Dim cG As cGroup
    
'set the source and results worksheets
Set wsSrc = ThisWorkbook.Worksheets("sheet1")
Set wsRes = ThisWorkbook.Worksheets("sheet2")
    Set rRes = wsRes.Cells(1, 1)

'read source data into vba array
With wsSrc
    vSrc = Range(.Cells(1, 1), .Cells(.Rows.Count, 2).End(xlUp))
End With

'set dictionary to collect the data
Set D = New Dictionary
    D.CompareMode = TextCompare

'iterate through the data
'pull out the min and max of the range
For I = 2 To UBound(vSrc, 1)
    sKey = vSrc(I, 1)
    Set cG = New cGroup
    If Not D.Exists(sKey) Then
        cG.Max = vSrc(I, 2)
        cG.Min = vSrc(I, 2)
        D.Add Key:=sKey, Item:=cG
    Else
        With D(sKey)
            .Max = IIf(.Max > vSrc(I, 2), .Max, vSrc(I, 2))
            .Min = IIf(.Min < vSrc(I, 2), .Min, vSrc(I, 2))
        End With
    End If
Next I

'create the results array
ReDim vRes(0 To D.Count, 1 To 2)

'Column Headers
vRes(0, 1) = "Range"
vRes(0, 2) = "Value"

I = 0
For Each v In D.Keys
    I = I + 1
    vRes(I, 1) = v & " Range"
    vRes(I, 2) = D(v).Min & "-" & D(v).Max
Next v

'write results to results worksheet

With rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
    .EntireColumn.Clear
    .NumberFormat = "@"
    .Value = vRes
    .Style = "Output" 'not internationally aware
    .EntireColumn.AutoFit
End With

End Sub

或者，使用 Windows Excel 2010+ 和 Office 365 中提供的 Power Query （我更喜欢它，因为它更短且更易于编程）：

选择数据表中的某个单元格
Data => Get&Transform => from Table/Range
当 PQ 编辑器打开时：Home => Advanced Editor
记下第 2 行中的表 Name
粘贴下面的 M 代码代替您看到的内容
将第 2 行中的表名称更改回最初生成的名称。
阅读 cmets 并探索 Applied Steps 以了解算法

M 码

let

//Read in the table
// Change Table name in next line to actual table name
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],

//type the data
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Group", type text}, {"Value", Int64.Type}}),

//Group by "Group"
//   then generate the min-max string
    #"Grouped Rows" = Table.Group(#"Changed Type", {"Group"}, {{"Value", 
        each Text.From(List.Min([Value])) & "-" & Text.From(List.Max([Value])), Text.Type }
        }),

//Add the word " Range" to the Group
    addRange = Table.TransformColumns(#"Grouped Rows",{"Group", each _ & " Range", Text.Type})

in
    addRange

从您的数据中产生相同的结果：

【讨论】：

【解决方案2】：

确实，在这种情况下，VBA 并不是最佳解决方案，因为单个公式可以提取您想要的所有数据。无需为每个组制定不同的公式。

=MINIFS(INDEX(Data,,2),INDEX(Data,,1),H2) & " - " & MAXIFS(INDEX(Data,,2),INDEX(Data,,1),H2)

动态命名范围的公式是=OFFSET(Sheet1!$A$2,0,0,COUNTA(Sheet1!$A:$A)-1,2)

【讨论】：

【解决方案3】：

如果你想使用公式，那么可以尝试下面的公式和Excel365。

D2=UNIQUE(A2:A6)
E2=MINIFS(B2:B6,A2:A6,D2#)&"-"&MAXIFS(B2:B6,A2:A6,D2#)

【讨论】：