我如何在動態范圍內找到3個偶數及其平均值

我有這個 vba-excel 問題我堅持了好幾天，我真的可以使用一些幫助。

我有一個動態范圍內的數字表（每次按下按鈕時都不同。）該表分布在整個范圍內。我需要在該表中找到三個數字：

1. 甚至
2. 這 3 個 nums 的 avg 是其中之一（在 nums 中）

在找到那個三重奏之后，我需要在表格中為它們著色并列印一個 msgbox，其中說明了區域邊界（例如 4X3..）以及這個三重奏存在的事實以及作為平均值的 num。

我只是在找到那個三重奏并以某種方式存盤它時遇到了問題。任何形式的幫助都會很棒。

這是我到目前為止所擁有的：

Private Sub CommandButton2_Click()
Dim rng As Range
Set rng = Range("a1").CurrentRegion
Dim cell As Range
Dim i As Integer
Dim j As Integer
Dim x As Integer
Dim y As Integer
x = rng.Rows.Count
y = rng.Columns.Count

For Each cell In rng
  If Not (cell.Value Mod 2 = 0) Then cell.Value = ""
    Next cell
    
    For Each cell In rng
    For i = 1 To rng.Rows.Count
    For j = 1 To rng.Columns.Count
        
        If Cells(i, j) - cell.Value = Abs(cell.Value - Cells(i, j)) Then
           
                Cells(i, j).Interior.Color = vbYellow
                MsgBox "the area is" & "" & x & "X" & y & vbNewLine & "there are 3 special nums" & vbNewLine & "avarege is " & "" & cell.Value
                End If
                Next j
                Next i
                Next cell
                
                 
                 MsgBox "the area is" & "" & x & "X" & y & vbNewLine & "there are no speacial nums"
                 
                 End Sub

范圍不能超過幾行或幾列。此外，三人組可以在桌子上的任何地方。這個想法是識別滿足上述要求的三人組。

uj5u.com熱心網友回復：

我認為最好的方法是首先擺脫奇數值，然后忽略重復資料，然后嘗試剩余數字的三重奏。無論如何，請注意，根據您獲得的不同值的數量，性能可能會受到影響。

另外，請注意，由于您的資料重復，有時您可能會突出顯示超過 3 個單元格。

確保您的活動單元格在檢查此代碼是否正常作業的范圍內！

代碼前：

代碼后：

Sub test()
Dim rng As Range
Dim MyNumbers() As Double
Dim Dict As Object
Dim MyKey As Variant
Dim i As Long
Dim j As Long
Dim k As Long



Set Dict = CreateObject("Scripting.Dictionary")

'this will work based on active cell. It will take complete region

For Each rng In ActiveCell.CurrentRegion
    'get rid of odd elements
    If Dict.Exists(rng.Value) = False And rng.Value / 2 = Int(rng.Value / 2) Then Dict.Add rng.Value, 0
Next rng

ReDim MyNumbers(1 To Dict.Count)

i = 1
For Each MyKey In Dict.Keys
    MyNumbers(i) = MyKey
    i = i   1
Next MyKey

Dict.RemoveAll


For i = 1 To UBound(MyNumbers) - 2 Step 1
    For j = (i   1) To UBound(MyNumbers) - 1 Step 1
        For k = (j   1) To UBound(MyNumbers) Step 1
            If (MyNumbers(i)   MyNumbers(j)   MyNumbers(k)) / 3 = MyNumbers(i) Or _
            (MyNumbers(i)   MyNumbers(j)   MyNumbers(k)) / 3 = MyNumbers(j) Or _
            (MyNumbers(i)   MyNumbers(j)   MyNumbers(k)) / 3 = MyNumbers(k) Then
                'there is a match, we save that part
                Dict.Add MyNumbers(i), 0
                Dict.Add MyNumbers(j), 0
                Dict.Add MyNumbers(k), 0
                MsgBox "There is a match." & vbNewLine & "Area is " & ActiveCell.CurrentRegion.Rows.Count & "x" & ActiveCell.CurrentRegion.Columns.Count
                GoTo Result
            End If
            
        Next k
    Next j
Next i

'there is no match
MsgBox "There is a match." & vbNewLine & "Area is " & ActiveCell.CurrentRegion.Rows.Count & "x" & ActiveCell.CurrentRegion.Columns.Count
GoTo Final

Result:
For Each rng In ActiveCell.CurrentRegion
    'highlight numbers in dict
    If Dict.Exists(rng.Value) = True Then rng.Interior.Color = vbYellow
Next rng

Final:
Erase MyNumbers
Set Dict = Nothing

End Sub

標籤：擅长 vba

上一篇：洗掉i時間序列中除最后兩個之外的所有資料標簽

下一篇：如何決議VBA代碼行指令