在下一轮循环中将 Cell 的值与相同的 Cell 进行比较

Question

以下场景： 我有不同的地区和不同的产品组。通过单元格 A1 中的下拉菜单区域和产品组通过单元格 A2 中的下拉菜单。在单元格 C3 中，我有一个公式取决于 A1 和 A2 的选择。 现在我想遍历不同的区域并为所有不同区域的每个产品组获取 C3 的最大值。另一个问题是有时 C3 会导致错误，因为 A1 和 A2 中的组合没有结果......

那是我的尝试，但不幸的是我的技能已达到极限。如果您能提供帮助，将不胜感激。谢谢

Sub FindMax()


Dim maxValue As Variant
Dim currentValue As Variant
Dim i As Integer
Dim j As Integer
Dim regions As Variant
Dim productGroups As Variant


regions = Array("Region 1", "Region 2", "Region 3")
productGroups = Array(1, 2, 3, 4, 5)


For i = LBound(regions) To UBound(regions)
    Range("A1").Value = regions(i)

    For j = LBound(productGroups) To UBound(productGroups)
        Range("A2").Value = productGroups(j)
        currentValue = Range("C3").Value
        If j = LBound(productGroups) Then
            maxValue = currentValue
        ElseIf currentValue > maxValue Then
            maxValue = currentValue
        End If
    Next j

Next i


MsgBox "The highest value for product group " & ws1.Range("A2").Value & " across all regions is: " & maxValue

End Sub

Answer 1

找到两个下拉列表的所有组合的最大值

• 如果您确定有数值，则不需要最后的 if 语句。如果你确定至少有一个正值，你既不需要IsFirstFound也不需要IsMax。
  但为什么碰巧呢？

Option Explicit

Sub MaxAcrossRegions()
    
    Dim Regions(): Regions = Array("Region 1", "Region 2", "Region 3")
    Dim ProductGroups(): ProductGroups = Array(1, 2, 3, 4, 5)
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim RegionCell As Range: Set RegionCell = ws.Range("A1")
    Dim ProductGroupCell As Range: Set ProductGroupCell = ws.Range("A2")
    Dim ValueCell As Range: Set ValueCell = ws.Range("C3")
    
    Dim CurrValue As Variant, MaxValue As Double, r As Long, p As Long
    Dim MaxProductGroup As String, MaxRegion As String
    Dim IsFirstFound As Boolean, IsMax As Boolean
    
    For r = LBound(Regions) To UBound(Regions)
        RegionCell.Value = Regions(r)
        For p = LBound(ProductGroups) To UBound(ProductGroups)
            ProductGroupCell.Value = ProductGroups(p)
            CurrValue = ValueCell.Value
            If IsNumeric(CurrValue) Then
                If IsFirstFound Then
                    If CurrValue > MaxValue Then IsMax = True
                Else
                    IsFirstFound = True ' set once, on the first numeric value
                    IsMax = True
                End If
                If IsMax Then
                    MaxValue = CurrValue
                    MaxProductGroup = ProductGroups(p)
                    MaxRegion = Regions(r)
                    IsMax = False ' reset for next iteration
                End If
            End If
        Next p
    Next r
    
    If IsFirstFound Then
        MsgBox "The highest value for a product group across all regions is " _
            & MaxValue & ", found in product group " & MaxProductGroup _
            & " of region " & MaxRegion & ".", vbInformation
    Else
        MsgBox "No numeric values found.", vbCritical
    End If
    
End Sub