查找列表中不同行的最大值和最小值 VBA excel

Question

我无法将我的思维过程转化为有形的代码，老实说，我不确定从哪里开始编写代码。我有一个包含两个适用列的数据集，为了简单起见，我们会说 A 和 B。A 包含三个首字母的列表，后跟一个数字，例如。 JFD3、JFD2、JFD6、EUW1、YMG2、YMG3。 B列有一个值。我需要找到每组首字母的最高值到最低值的范围，这让我想到了一个最大 - 最小的解决方案。首字母列表不一定按顺序排列，可以有一组首字母（净方差为 0，这没关系），或者最多 8 组首字母，数字不一定是连续的。我在想某种 Match(Left(3)) 但我认为这不会包含所有内容。

任何关于从哪里开始的想法都将不胜感激。如果有任何问题，我很乐意澄清。

Answer 1

使用枢轴 Table。将您的 A 列字段 ^* 放入 Row Labels，然后将 B 列放入 Values 两次。将一个从 Sum 更改为 Min，将另一个从 Sum 更改为 Max。

^* 不确定您是否需要按 JFD 对所有 JFDx 或每个 JFDx 进行分组。如果您需要将它们按 3 个首字母分组，请制作 C 列 =left("A1",3)，然后在您的

中使用它

Answer 2

一种方法可以是：

将A-B范围内的数据按A的字母顺序排序。为此，您可以在执行此操作时录制宏并编辑代码以使其每次都动态运行。这是需要才能使下面的解决方案有效，更有效许多其他类型的类似方法。

使用 While 块来运行解决方案。我让你花时间构建和测试工作代码，但这是我的想法：

startSubset = 2 '<-- we start getting the key from row 2
'build the key to define the subset
keyStart = 1 
currentKey = ""
Do While Not IsNumeric(Right(Left(Range("A" & startSubset),keyStart),1))
    'while the last char of the key is not numeric, let's add it to the key
    currentKey = currentKey & Right(Left(Range("A" & startSubset),keyStart),1)
    keyStart = keyStart + 1
Loop

经过上面的操作之后，key就存储在变量currentKey中了。如果第一个单元格是 JFD213，它将是 JFD，等等。因此，您循环直到该子集的末尾，将最大值和最小值存储在两个变量中：

    min = 0
    max = 0
    Do While Left(Range("A" & startSubset),Len(currentKey)) = currentKey
        If Range("B" & startSubset) < min Then min = Range("B" & startSubset)
        If Range("B" & startSubset) > max Then max = Range("B" & startSubset)
        startSubset = startSubset + 1
    Loop

完成后，您只需将值转换为集合即可，例如：

myObs.Add(currentKey)
myObs.Add(min)
myObs.Add(max) '<-- you will get something like myObs = ("DJF", 0, 100)

然后将此对象转换为更大的集合：

    allValues.Add(myObs) '<-- at the end you will have something like this:
    'allValues = [("DJF",0,100), ("ABC", 1, 75), ...]

并重新设置值以让它们继续：

    currentKey = ""
    keyStart = 1

以上所有，应该是运行在 While 循环中，当数据结束时该循环将中断。

请注意，以上代码不能单独运行，但它是解决您需要重新处理数据以使其在现实生活中运行的问题的一种可能方法。

Answer 3

您可以使用脚本运行时中的词典轻松完成此操作。使用其中两个以首字母作为键，一个保存找到的最小值，另一个保存找到的最大值。

添加对 Microsoft Scripting Runtime 的引用（工具 -> 添加引用...，然后选中 "Microsoft Scripting Runtime" 旁边的框）或延迟绑定（请参阅下面的说明）。像这样的东西应该可以解决问题，假设第 1 列中有首字母，第 2 列中有值，没有 headers:

Private Sub MinMax()    
    Dim mins As Dictionary
    Dim maxes As Dictionary
    Dim sheet As Worksheet

    Set sheet = ActiveSheet
    Set mins = New Dictionary
    Set maxes = New Dictionary

    Dim row As Long
    For row = 1 To sheet.UsedRange.Rows.Count
        Dim key As Variant
        Dim val As Integer

        key = sheet.Cells(row, 1).Value2
        If Len(key) >= 3 Then
            key = Left$(sheet.Cells(row, 1).Value2, 3)
            val = sheet.Cells(row, 2).Value2

            If Not mins.Exists(key) Then
                mins.Add key, val
            Else
                If mins(key) > val Then mins(key) = val
            End If

            If Not mins.Exists(key) Then
                maxes.Add key, val
            Else
                If maxes(key) < val Then maxes(key) = val
            End If
        End If
    Next row

    For Each key In mins.Keys
        Debug.Print key & ": Min = "; mins(key) & " Max = "; maxes(key)
    Next key
End Sub

要使用后期绑定，代码与这些例外完全相同。不要将 mins 和 maxes 声明为 Dictionary，而是将它们声明为 Object:

    Dim mins As Object
    Dim maxes As Object

而不是将它们设置为新词典，使用创建Object:

    Set sheet = ActiveSheet
    Set mins = CreateObject("Scripting.Dictionary")
    Set maxes = CreateObject("Scripting.Dictionary")

查找列表中不同行的最大值和最小值 VBA excel

Finding Max & Min for varying lines in a list VBA excel

excel

vba

max

min