Dò tìm và tính trung bình (1 người xem)

[hoangnam2015]

Em có file bên dưới. Mục đích là dò tìm các kết quả trùng nhau, sau đó tính giá trị trung bình. ai giúp em viết đoạn code với. em cảm ơn.

 

[Hau151978]

Em có file bên dưới. Mục đích là dò tìm các kết quả trùng nhau, sau đó tính giá trị trung bình. ai giúp em viết đoạn code với. em cảm ơn.

Bài này dùng VBA thì khó lắm.
Dùng công thức: Bạn copy cột giống lúa sang sheet2, chọn Data - Remove duplicates để tạo danh sách duy nhất. Tại ô B17=IFERROR(AVERAGEIF(Sheet1!$A$5:$A$13,sheet2!$A17,Sheet1!C$5:C$13),0) kéo sang phải và xuống dưới.

 

[alodie123]

Mình ghi đc macro thủ công này bạn xem thử nhé. Mới học tý VBA nên ko bít dùng Array hay Dic.
Sub test()
Set ws = Sheet1
Set ws2 = Sheet2
Application.ScreenUpdating = False
ws2.Range("A17:I500").ClearContents
ws.Activate
ws.AutoFilterMode = False
Range("L1:S1").Formula = "=IFERROR(AVERAGE(L2:L50),0)"
lr = Range("A" & Rows.Count).End(xlUp).Row
Range("A4:A" & lr).Copy
Range("K1").PasteSpecial (xlPasteValues)
Columns("K:K").RemoveDuplicates Columns:=1, Header:=xlYes
Set Rng = Range("K2:K" & Range("K" & Rows.Count).End(xlUp).Row)
For Each glua In Rng
Columns("A:I").AutoFilter field:=1, Criteria1:=glua
Range("C4:J" & lr).SpecialCells(xlCellTypeVisible).Copy
ws.AutoFilterMode = False
Range("L2").PasteSpecial (xlPasteValues)
Range("L1:S1").Copy
lrp = ws2.Range("A" & Rows.Count).End(xlUp).Row + 1
ws2.Range("A" & lrp) = glua
ws2.Range("B" & lrp).PasteSpecial (xlPasteValues)
ws.Range("L2:S50").ClearContents
Next glua
ws.Columns("K:S").Delete
Application.ScreenUpdating = True
End Sub

 

[n0thing1988]

Bài này dùng Pivotable cũng được.