第1个回答 2016-01-24
Sub s()
ct = 2
Set d = CreateObject("scripting.dictionary")
For i = 11 To 20
d(Cells(2, i).Text) = Val(Cells(3, i))
Next
c = 0
Do While c < ct
t = 0
For Each k In d.keys
If d(k) > t Then t = d(k)
Next
For Each k In d.keys
If d(k) = t Then
For i = 1 To 3 Step 2
For j = 5 To 9
If Cells(i, j).Text = k Then
Cells(i + 1, j) = Cells(i + 1, j) + 1
d.Remove (k)
c = c + 1
End If
Next
Next
End If
Next
Loop
d.RemoveAll
For i = 11 To 20
d(Cells(8, i).Text) = Val(Cells(9, i))
Next
c = 0
Do While c < ct
t = 0
For Each k In d.keys
If d(k) > t Then t = d(k)
Next
For Each k In d.keys
If d(k) = t Then
For i = 7 To 9 Step 2
For j = 5 To 9
If Cells(i, j).Text = k Then
Cells(i + 1, j) = Cells(i + 1, j) + 1
d.Remove (k)
c = c + 1
End If
Next
Next
End If
Next
Loop
End Sub本回答被提问者采纳