请高手帮忙，用VBA编程

ytnet

求助大神们用VBA编程，辛苦大神们！

ione_fox

1. ption Explicit
   
2. 
   
3. Const Status$ = "身份"
   
4. Const Title$ = "职称"
   
5. Const PHD$ = "博"
   
6. Const MA$ = "硕"
   
7. Const BA$ = "本"
   
8. Const Coll$ = "专"
   
9. 
   
10. Const PaysCales$ = "薪级"
    
11. 
    
12. Sub Main()
    
13.     Dim Ar, I&, Dic, Keys, Items, J&
    
14.     Ar = Sheets("员工统计表").UsedRange
    
15.     Set Dic = ParseData
    
16.     For I = 2 To UBound(Ar)
    
17.     If Ar(I, 11) = "干部" Then
    
18.            If IsEmpty(Dic(Ar(I, 11))(Ar(I, 16))(Ar(I, 12))) Then
    
19.            
    
20.            Else
    
21.                Keys = Dic(Ar(I, 11))(Ar(I, 16))(Ar(I, 12)).Keys
    
22.                Items = Dic(Ar(I, 11))(Ar(I, 16))(Ar(I, 12)).Items
    
23.            End If
    
24.         
    
25.            For J = 0 To UBound(Keys)
    
26.                If Ar(I, 14) >= Keys(J) Then
    
27.                    Cells(I, "t") = Items(J)
    
28.                    Exit For
    
29.                End If
    
30.            Next J
    
31.     End If
    
32.     Next I
    
33. On Error GoTo 0
    
34. End Sub
    
35. 
    
36. 
    
37. Public Function ParseData()
    
38.     Dim Dcol, Dic, Dtemp
    
39.     Dim Ar, I&
    
40.     Ar = Sheets(PaysCales).Range("a1").CurrentRegion
    
41. '=====================列字段===========================
    
42.     Set Dcol = CreateObject("Scripting.Dictionary")
    
43.     For I = 1 To UBound(Ar, 2)
    
44.         Dcol(Ar(1, I)) = I
    
45.     Next I
    
46. '=======================================================
    
47.     Set Dic = CreateObject("Scripting.Dictionary")
    
48.     For I = 2 To UBound(Ar)
    
49.         '依据(身份)创建字典
    
50.         If IsEmpty(Dic(Ar(I, Dcol(Status)))) Then
    
51.             Set Dic(Ar(I, Dcol(Status))) = CreateObject("Scripting.Dictionary")
    
52.         End If
    
53.         Set Dtemp = Dic(Ar(I, Dcol(Status)))
    
54.         
    
55.         '依据(身份)(职称)创建字典
    
56.         If IsEmpty(Dtemp(Ar(I, Dcol(Title)))) Then
    
57.             Set Dtemp(Ar(I, Dcol(Title))) = CreateObject("Scripting.Dictionary")
    
58.         End If
    
59.         Set Dtemp = Dtemp(Ar(I, Dcol(Title)))
    
60.         '依据（身份)(职称)(P|M|B|C)创建字典
    
61.       
    
62.         If IsEmpty(Dtemp(PHD)) Then Set Dtemp(PHD) = CreateObject("Scripting.Dictionary")
    
63.         If IsEmpty(Dtemp(MA)) Then Set Dtemp(MA) = CreateObject("Scripting.Dictionary")
    
64.         If IsEmpty(Dtemp(BA)) Then Set Dtemp(BA) = CreateObject("Scripting.Dictionary")
    
65.         If IsEmpty(Dtemp(Coll)) Then Set Dtemp(Coll) = CreateObject("Scripting.Dictionary")
    
66.         
    
67.         Dtemp(PHD)(Ar(I, Dcol(PHD))) = Ar(I, 1)
    
68.         Dtemp(MA)(Ar(I, Dcol(MA))) = Ar(I, 1)
    
69.         Dtemp(BA)(Ar(I, Dcol(BA))) = Ar(I, 1)
    
70.         Dtemp(Coll)(Ar(I, Dcol(Coll))) = Ar(I, 1)
    
71.       
    
72.     Next I
    
73. 
    
74.     Set ParseData = Dic
    
75.     Set Dic = Nothing
    
76.     Set Dtemp = Nothing
    
77.     Set Dcol = Nothing
    
78. End Function
    

复制代码

ione_fox

抛转引玉，做了干部部分的薪级识别。思维有些乱了