补全任课老师

半百

练习练习

1. Sub test()  '替换
   
2. Set d = CreateObject("Scripting.dictionary")
   
3. c = Cells(4, Columns.Count).End(1).Column
   
4. r = Cells(Rows.Count, 1).End(3).Row
   
5. For i = 5 To r
   
6.     For j = 3 To c
   
7.         s = Cells(i, j).Value
   
8.         s1 = Left(s, 1)
   
9.         If s1 <> "" And s1 <> "自" Then
   
10.             a = Split(s, vbLf)
    
11.             If a(1) = "" Then
    
12.                 If d.exists(s1) Then
    
13.                     Cells(i, j) = Cells(i, j) & d(s1)
    
14.                 Else
    
15.                     a(1) = s1 & 0
    
16.                     Cells(i, j) = Join(a, vbLf)
    
17.                 End If
    
18.             Else
    
19.                 d(s1) = a(1)
    
20.                 Rows(i).Replace What:=s1 & 0, Replacement:=a(1)
    
21.             End If
    
22.         End If
    
23.     Next
    
24. Next
    
25. End Sub
    
26. 
    
27. 
    
28. 
    
29. 
    
30. Sub test2()  '数组
    
31. Set d = CreateObject("Scripting.dictionary")
    
32. c = Cells(4, Columns.Count).End(1).Column
    
33. r = Cells(Rows.Count, 1).End(3).Row
    
34. arr = Range("c5", Cells(r, c))
    
35. For i = 1 To UBound(arr)
    
36.     For j = 1 To UBound(arr, 2)
    
37.         s = arr(i, j)
    
38.         s1 = Left(s, 1)
    
39.         If s1 <> "" And s1 <> "自" Then
    
40.             a = Split(s, vbLf)
    
41.             s2 = d(s1)
    
42.             If a(1) = "" Then
    
43.                 If Left(s2, 1) = "," Or s2 = "" Then
    
44.                     d(s1) = s2 & "," & j
    
45.                 ElseIf Len(s2) > 1 Then
    
46.                     arr(i, j) = arr(i, j) & s2
    
47.                 End If
    
48.             Else
    
49.                 If Left(s2, 1) = "," Then
    
50.                     b = Split(s2, ",")
    
51.                     For k = 1 To UBound(b)
    
52.                         arr(i, b(k)) = arr(i, b(k)) & a(1)
    
53.                     Next
    
54.                  End If
    
55.                     d(s1) = a(1)
    
56.             End If
    
57.         End If
    
58.     Next
    
59.     d.RemoveAll
    
60. Next
    
61. Range("c5", Cells(r, c)) = arr
    
62. End Sub
    
63. 
    

复制代码

半百

1. 
   

复制代码