Sub 统计()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object, dc As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("票情")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 4 Then MsgBox "票情为空！": End
ar = .Range("a3:p" & r)
End With
With Sheets("统计")
.Range("a5:ae" & r) = Empty
br = .Range("a4:ae" & r)
For j = 6 To 25
d(br(1, j)) = j
Next j
k = 1
For i = 2 To UBound(ar)
If ar(i, 2) <> "" And ar(i, 5) <> "" Then
zd = ar(i, 2) & "|" & ar(i, 5)
t = d(zd)
If t = "" Then
k = k + 1
d(zd) = k
t = k
br(k, 1) = k - 1
br(k, 2) = ar(i, 5)
br(k, 3) = ar(i, 2)
End If
If ar(i, 15) = "√" And ar(i, 16) = "√" Then
br(t, 4) = br(t, 4) + 1
Else
br(t, 5) = br(t, 5) + 1
End If
For j = 7 To 11
zf = ar(1, j) & ar(i, j)
lh = d(zf)
If lh <> "" Then
br(t, lh) = br(t, lh) + 1
End If
Next j
End If
Next i
For i = 2 To k
lh = 25: hj = 0
For j = 6 To 25 Step 4
lh = lh + 1
hj = 0
hj = br(i, j) + br(i, j + 1) + br(i, j + 2) + br(i, j + 3)
br(i, lh) = (br(i, j) + br(i, j + 1) * 0.8 + br(i, j + 2) * 0.6 + br(i, j + 3) * 0.4) / hj
Next j
br(i, 31) = br(i, 26) + br(i, 27) + br(i, 28) + br(i, 29) + br(i, 30)
Next i
.[a4].Resize(k, UBound(br, 2)) = br
.[a4].Resize(k, 31).Sort .[b4], 2, , , , , , 1 '
End With
MsgBox "ok!"
End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-2-20 11:42
发表于 2024-2-20 17:57
楼主