Question

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

任何关于从哪里开始的想法都将非常感激。我很乐意澄清是否有任何问题。

Answer 1

您可以使用Scripting Runtime中的词典轻松完成此操作。使用其中两个以首字母为键，一个包含找到的最小值，另一个包含找到的最大值。

添加对Microsoft Scripting Runtime的引用（Tools-＆gt; Add reference ...，然后选中“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

而不是将它们设置为New Dictionary，请使用CreateObject：

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

Answer 2

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

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

中使用它

Answer 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中。如果第一个单元格是JFD等，它将是JFD213。因此，你循环直到这个子集的末尾存储两个变量中的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循环中运行，该循环将在数据结束时中断。

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

寻找Max＆amp;列表中不同行的最小值VBA excel

3 个答案: