Sub 获取成绩()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant
Dim i As Long
Dim arr()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a3:v" & r)
End With
ReDim arr(1 To UBound(ar), 1 To 10)
For i = 2 To UBound(ar)
If Trim(ar(i, 12)) = "本次付款" Then
If Trim(ar(i, 11)) = "员工" Then
zf = Trim(ar(i, 2)) & "|" & Trim(ar(i, 6))
t = d(zf)
If t = "" Then
k = k + 1
d(zf) = k
t = k
arr(k, 1) = ar(i, 13)
arr(k, 2) = ar(i, 2)
arr(k, 3) = ar(i, 15)
arr(k, 4) = ar(i, 16)
arr(k, 5) = ar(i, 17)
arr(k, 8) = ar(i, 20)
arr(k, 9) = ar(i, 21)
arr(k, 10) = ar(i, 22)
End If
arr(t, 6) = arr(t, 6) + ar(i, 8)
If arr(t, 7) = "" Then
arr(t, 7) = ar(i, 19)
Else
arr(t, 7) = arr(t, 7) & "/" & ar(i, 19)
End If
ElseIf Trim(ar(i, 11)) = "客户" Then
zf = Trim(ar(i, 2)) & "|" & Trim(ar(i, 6))
t = d(zf)
If t = "" Then
k = k + 1
d(zf) = k
t = k
arr(k, 1) = ar(i, 13)
arr(k, 2) = ar(i, 2)
arr(k, 3) = ar(i, 15)
arr(k, 4) = ar(i, 16)
arr(k, 5) = ar(i, 17)
arr(k, 6) = ar(i, 18)
arr(k, 7) = ar(i, 19)
arr(k, 8) = ar(i, 20)
arr(k, 9) = ar(i, 21)
arr(k, 10) = ar(i, 22)
End If
End If
End If
Next i
With Sheet2
.UsedRange.Offset(3) = Empty
.[a4].Resize(k, UBound(arr, 2)) = arr
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|