时间戳

首页 > 解决方案 > VBA - 使用指定的顺序进行决胜局

excel - VBA - 使用指定的顺序进行决胜局

问题描述

Value1 = Application.WorksheetFunction.CountIf(Range("AE1:AE5000"), “firststring”)
Value2 = Application.WorksheetFunction.CountIf(Range("AE1:AE5000"), “secondstring”)
Value3 = Application.WorksheetFunction.CountIf(Range("AE1:AE5000"), “thirdstring”)
Value4 = Application.WorksheetFunction.CountIf(Range("AE1:AE5000"), “fourthstring”)

MaxValue = WorksheetFunction.Max(Value1, Value2, Value3, Value4)

If MaxValue = Value1 Then
'Do something
ElseIf MaxValue = Value2 Then
'Do another thing
ElseIf MaxValue = Value3 Then
'Do yet another thing
ElseIf MaxValue = Value4 Then
'Do another thing
End If

我正在尝试运行脚本的不同部分，具体取决于 4 个整数变量中的哪一个具有最高值。但是，我不确定如何在决胜局条件下进行编码，例如，如果有多个变量具有相同的最高值，则 Value1 将被视为最高值，然后依次是 Value2、Value3 和 Value4。

标签： excelvba

解决方案

决胜局

做一件事

Option Explicit

Sub TieBreaker()
    
    Const CriteriaList As String = "first,second,third,fourth"
    Dim Criteria() As String: Criteria = Split(CriteriaList, ",")
    
    Dim n As Long: n = UBound(Criteria)
    
    Dim Data() As Long: ReDim Data(0 To n)
    
    For n = 0 To n
        Data(n) = Application.CountIf(Range("AE1:AE5000"), Criteria(n))
    Next n
    
    Dim cMax As Long: cMax = Application.Max(Data)
    Dim cIndex As Long: cIndex = Application.Match(cMax, Data, 0) - 1
    
    Select Case cIndex
    Case 0
        'Do something
        Debug.Print 0, Data(0), Criteria(0)
    Case 1
        'Do another thing
        Debug.Print 1, Data(1), Criteria(1)
    Case 2
        'Do yet another thing
        Debug.Print 2, Data(2), Criteria(2)
    Case 3
        'Do another thing
        Debug.Print 3, Data(3), Criteria(3)
    End Select

End Sub

只做一件事

Sub TieBreaker()
    
    Dim value1 As Long: value1 = 2
    Dim value2 As Long: value2 = 3
    Dim value3 As Long: value3 = 3
    Dim value4 As Long: value4 = 1

    Dim Data(1 To 4) As Long
    Data(1) = value1
    Data(2) = value2
    Data(3) = value3
    Data(4) = value4
    
    Dim cMax As Long: cMax = Application.Max(Data)
    Dim cIndex As Long: cIndex = Application.Match(cMax, Data, 0)
    
    Select Case cIndex
    Case 1
        'Do something
        Debug.Print 1, Data(1)
    Case 2
        'Do another thing
        Debug.Print 2, Data(2)
    Case 3
        'Do yet another thing
        Debug.Print 3, Data(3)
    Case 4
        'Do another thing
        Debug.Print 4, Data(4)
    End Select

End Sub

结果

 2             3

按降序做所有事情

Sub TieBreakerAll()
    
    Dim value1 As Long: value1 = 2
    Dim value2 As Long: value2 = 3
    Dim value3 As Long: value3 = 3
    Dim value4 As Long: value4 = 1

    Dim Data(1 To 4, 1 To 2) As Long
    Data(1, 1) = value1: Data(1, 2) = 1
    Data(2, 1) = value2: Data(2, 2) = 2
    Data(3, 1) = value3: Data(3, 2) = 3
    Data(4, 1) = value4: Data(4, 2) = 4
    
    ' Bubble Sort
    Dim tmp(1 To 2) As Long
    Dim i As Long, k As Long
    For i = 1 To 3
        For k = i + 1 To 4
            If Data(i, 1) < Data(k, 1) Then
                tmp(1) = Data(i, 1): tmp(2) = Data(i, 2)
                Data(i, 1) = Data(k, 1): Data(i, 2) = Data(k, 2)
                Data(k, 1) = tmp(1): Data(k, 2) = tmp(2)
            End If
        Next k
    Next i
    
    For i = 1 To 4
        
        k = Data(i, 2) ' the order
        
        Select Case k
        Case 1
            'Do something
            Debug.Print 1, Data(i, 1)
        Case 2
            'Do another thing
            Debug.Print 2, Data(i, 1)
        Case 3
            'Do yet another thing
            Debug.Print 3, Data(i, 1)
        Case 4
            'Do another thing
            Debug.Print 4, Data(i, 1)
        End Select
    
    Next i

End Sub

结果

 2             3 
 3             3 
 1             2 
 4             1

推荐阅读