Sub yy()
Dim Arr, i&, x$, r%, Arr1(), aa, j&, mn
Dim d, k, t, rng As Range
Set d = CreateObject("Scripting.Dictionary")
'Sheet1.Activate
Arr = [a1].CurrentRegion
For i = 2 To UBound(Arr)
x = Arr(i, 1) & "|" & Arr(i, 2)
'获取同一个日期+型号所在的行号,用逗号连接起来,比如2,5,8,
d(x) = d(x) & i & ","
Next
k = d.keys '日期+型号的唯一值列表
t = d.items '行号列表
For i = 0 To UBound(k)
r = 0
'去掉2,5,8,最后面的逗号,变成2,5,8
t(i) = Left(t(i), Len(t(i)) - 1)
If InStr(t(i), ",") Then
'得到行号数组[2,5,8]
aa = Split(t(i), ",")
For j = 0 To UBound(aa)
r = r + 1
ReDim Preserve Arr1(1 To r)
'价格数组[11,12,11]
Arr1(r) = Arr(aa(j), 3)
If rng Is Nothing Then
Set rng = Cells(aa(j), 9)
Else
Set rng = Union(rng, Cells(aa(j), 9))
End If
Next
Else
Cells(t(i), 9) = Cells(t(i), 3).Value
End If
'从[11,12,11]中得到最低价格11
mn = Application.Min(Arr1)
'把所有同一个日期+型号的单元格都填入最低价11
If Not rng Is Nothing Then rng = mn
Set rng = Nothing
'Stop ‘测试暂停
Next
End Sub