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

【问题标题】：Finding Max & Min for varying lines in a list VBA excel查找列表VBA excel中不同行的最大值和最小值
【发布时间】：2015-06-16 10:49:02
【问题描述】：

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

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

【问题讨论】：

标签： vba excel max min

【解决方案1】：

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

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

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

不要将它们设置为新字典，而是使用 CreateObject：

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

【讨论】：

谢谢，我喜欢这种方法。但是，我无法拉入对象。我使用了您在评论中的代码行CreateObject("Scripting.Dictionary")，但无济于事。我收到错误“未定义用户定义的类型”。我在更大的宏中使用此代码，在 sub 之前没有“私人”标签。这会是潜在的原因吗？我不太确定“私人”标签会发生什么变化。
@Swolerosis - 如果您使用的是 CreateObject，您还需要将变量声明更改为 Object。查看编辑。
谢谢！这很完美。您是否偶然知道我可以在某个地方阅读有关对象和实现的信息？
@Swolerosis - 哇，现在那是一个棘手的问题。您应该了解的第一个对象模型是 Office 对象和脚本运行时（它大约占我在 VBA 中编写的代码的 80-90%）。 MS 文档是here。更一般地说，对象浏览器是我的首选。在你的 IDE 中点击F2，你会看到函数原型、返回值等。

【解决方案2】：

使用数据透视表。将 A 列字段^* 放入 Row Labels，然后将 B 列放入 Values 中两次。将一个从Sum 更改为Min，将另一个从Sum 更改为Max。

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

中使用它

【讨论】：

对不起，我应该指定的，我正在尝试将它放入 VBA。该项目总体上查看数据中的各种值和项目，并针对每个项目的超出我的容忍范围的任何问题吐出报告。

【解决方案3】：

解决方法可能是：

按字母顺序将 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

在上面之后，密钥存储在变量currentKey中。如果第一个单元格是 JFD213 等，它将是 JFD。因此，您循环直到该子集的末尾将 max 和 min 存储在两个变量中：

    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 循环中运行，当数据结束时会中断。

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

【讨论】：