VBA在列中找到相同值的范圍並計算平均值

Question

我想在A列中找到一個范圍相同的值，然后計算出平均值，有人可以幫助我嗎？ 代碼下方：

https://i.stack.imgur.com/bU1hW.png

Sub test()
    Dim sht As Worksheet
    Dim LastRow As Long
    Set sht = ThisWorkbook.Worksheets("Sheet1")
    LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

For i = 1 To LastRow
Columns("A:A").Select
    Set cell = sELECTION.Find(What:="i", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)

If cell Is Nothing Then
    'do it something

Else
    'do it another thing
End If

End Sub

謝謝 ！

Answer 1

解決方案1

嘗試這個

Sub test()
    Dim sht As Worksheet
    Dim inputLR As Long, outputLR As Long
    Dim cel As Range, aRng As Range, bRng As Range

    Set sht = ThisWorkbook.Worksheets("Sheet1") 'your data sheet

    With sht
        inputLR = .Cells(.Rows.Count, "A").End(xlUp).Row    'last row in column A
        outputLR = .Cells(.Rows.Count, "D").End(xlUp).Row   'last row in column D
        Set aRng = .Range(.Cells(2, 1), .Cells(inputLR, 1)) 'data range in column A
        Set bRng = .Range(.Cells(2, 2), .Cells(inputLR, 2)) 'data range in column B

        For Each cel In .Range(.Cells(2, 4), .Cells(outputLR, 4))   'loop through each cell in Column D
            cel.Offset(0, 1) = Application.WorksheetFunction.AverageIf(aRng, cel, bRng) 'calculate average
        Next cel
    End With
End Sub

參見圖片以供參考。

解決方案2

另一個更簡單的方法是使用公式。 在Cell E2輸入以下公式

=AVERAGEIF($A$2:$A$11,D2,$B$2:$B$11)

根據需要向下拖動/復制。 根據您的數據更改范圍。

有關AVERAGEIF詳細信息，請參閱此 。

---

編輯：1

Sub test()
    Dim sht As Worksheet
    Dim inputLR As Long, outputLR As Long
    Dim cel As Range, aRng As Range, bRng As Range
    Dim dict As Object, c As Variant, i As Long

    Set dict = CreateObject("Scripting.Dictionary")
    Set sht = ThisWorkbook.Worksheets("Sheet1") 'your data sheet

    With sht
        inputLR = .Cells(.Rows.Count, "A").End(xlUp).Row    'last row in column A
        Set aRng = .Range(.Cells(2, 1), .Cells(inputLR, 1)) 'data range in column A
        Set bRng = .Range(.Cells(2, 2), .Cells(inputLR, 2)) 'data range in column B

        c = aRng
        For i = 1 To UBound(c, 1)
            dict(c(i, 1)) = 1
        Next i
        .Range("D2").Resize(dict.Count) = Application.Transpose(dict.keys)  'display uniques from column A
        outputLR = .Cells(.Rows.Count, "D").End(xlUp).Row   'last row in column D

        For Each cel In .Range(.Cells(2, 4), .Cells(outputLR, 4))   'loop through each cell in Column D
            cel.Offset(0, 1) = Application.WorksheetFunction.AverageIf(aRng, cel, bRng) 'calculate average
        Next cel
    End With
End Sub

---

編輯：2要獲得Min ，而不是

For Each cel In .Range(.Cells(2, 4), .Cells(outputLR, 4))   'loop through each cell in Column D
    cel.Offset(0, 1) = Application.WorksheetFunction.AverageIf(aRng, cel, bRng) 'calculate average
Next cel

采用

For Each cel In .Range(.Cells(2, 4), .Cells(outputLR, 4))   'loop through each cell in Column D
    cel.Offset(0, 1).FormulaArray = "=MIN(IF(" & aRng.Address & "=" & cel.Value & "," & bRng.Address & "))"
Next cel
.Range(.Cells(2, 4), .Cells(outputLR, 4)).Offset(0, 1).Value = .Range(.Cells(2, 4), .Cells(outputLR, 4)).Offset(0, 1).Value

Answer 2

使用WorksheetFunction.AverageIf函數，請參見下面的代碼：

Sub test()

Dim sht As Worksheet
Dim LastRow As Long
Dim Rng As Range
Dim Avg1 As Double, Avg2 As Double

Set sht = ThisWorkbook.Worksheets("Sheet1")
With sht
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("A1:A" & LastRow)
    ' average of values in column B of all cells in column A = 1
    Avg1 = WorksheetFunction.AverageIf(Rng, "1", .Range("B1:B" & LastRow))

    ' average of values in column B of all cells in column A = 2
    Avg2 = WorksheetFunction.AverageIf(Rng, "2", .Range("B1:B" & LastRow))
End With

End Sub

Answer 3

這是使用變量數組方法。 嘗試這個。

Sub test()
    Dim sht As Worksheet
    Dim LastRow As Long
    Dim vDB, vR(), rngDB, vResult()
    Dim r As Integer, n As Long, j As Long, i As Integer

    Set sht = ThisWorkbook.Worksheets("Sheet1")
    With sht
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        rngDB = .Range("a1", "b" & LastRow)
        vDB = .Range("d2", .Range("d" & Rows.Count).End(xlUp))

        r = UBound(vDB, 1)
        ReDim vResult(1 To r)
        For i = 1 To r
            n = 0
            For j = 1 To LastRow
                If vDB(i, 1) = rngDB(j, 1) Then
                    n = n + 1
                    ReDim Preserve vR(1 To n)
                    vR(n) = rngDB(j, 2)
                End If
            Next j
            vResult(i) = WorksheetFunction.Average(vR)
        Next i
        .Range("e2").Resize(r) = WorksheetFunction.Transpose(vResult)
    End With
End Sub

Answer 4

使用.Find函數

1. 在A列中查找不包含重復項的值
2. 在Find功能上使用唯一值
3. 找到值后，將B列中和計數器上的值相加

4. 將總和除以計數器以獲得平均值

    Dim ws As Worksheet Dim rng As Range, rngloop As Range, cellFound As Range, c As Range Set ws = ThisWorkbook.Sheets(1) lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Set rng = ws.Range(ws.Cells(2, 1), ws.Cells(lastrow, 1)) For i = 2 To lastrow Set c = ws.Cells(i, 1) Set rngloop = ws.Range(ws.Cells(2, 1), ws.Cells(i, 1)) x = Application.WorksheetFunction.CountIf(rngloop, c) If x = 1 Then 'Debug.Print c 'Values in column A without duplicates 'Work with the values found With rng Set cellFound = .Find(what:=c, LookIn:=xlValues, MatchCase:=False) If Not cellFound Is Nothing Then FirstAddress = cellFound.Address Do SumValues = ws.Cells(cellFound.Row, 2) + SumValues k = k + 1 Set cellFound = .FindNext(cellFound) Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress AverageValues = SumValues / k Debug.Print "Value: " & c & " Average: " & AverageValues End If End With End If k = 0 SumValues = 0 Next i 

請注意， .Find的使用比CreateObject("Scripting.Dictionary")速度慢，因此對於大型電子表格，@ Mrig的代碼已優化

Answer 5

請嘗試以下代碼：

Sub test()

    Dim sht As Worksheet
    Dim LastRow As Long
    Set sht = ThisWorkbook.Worksheets("Sheet1")
    LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row

    For i = 1 To LastRow        
        If Application.WorksheetFunction.CountIf(sht.Range("A1:A" & LastRow), sht.Range("A" & i)) > 1 Then
            'if found more than one value
            'do it another thing
            sht.Range("B" & i) = Application.WorksheetFunction.SumIf(sht.Range("A1:A" & LastRow), _
                            sht.Range("A" & i)) / Application.WorksheetFunction.CountIf(sht.Range("A1:A" & LastRow), sht.Range("A" & i))
        Else
           'do it another thing
        End If
    Next i

End Sub

希望能有所幫助。