[已解决]类型不匹配，这怎么解决

hwc2ycy

1. Private Sub CommandButton1_Click()
   
2.     Dim arr, brr, i&, j%, r&, k, crr(1 To 1, 1 To 8), temp
   
3.     'Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     Set d1 = CreateObject("Scripting.Dictionary")
   
6.     With Sheets("Rawdata")
   
7.         temp = .FilterMode
   
8.         If temp Then .ShowAllData
   
9.         r = .Cells(Rows.Count, 1).End(xlUp).Row
   
10.                ' r = .Cells.Find("*", Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row    '计算工作表最后一个非空行号
    
11.         arr = .Range("a2:j" & r)
    
12.     End With
    
13.     With Sheets("医院同期对比")
    
14.         brr = .[n5:u5]
    
15. 
    
16.         For i = 1 To UBound(brr, 2)
    
17. 
    
18.             d1(brr(1, i)) = i
    
19. 
    
20.         Next
    
21. 
    
22.         For i = 1 To UBound(arr)
    
23. 
    
24.             k = arr(i, 3) & "," & arr(i, 4) & "," & arr(i, 2) & "," & arr(i, 7)
    
25.             Debug.Print k
    
26. 
    
27.             If Not d.exists(k) Then Set d(k) = CreateObject("Scripting.Dictionary")
    
28. 
    
29.             If Not d(k).exists(arr(i, 9)) Then
    
30. 
    
31.                 crr(1, d1(arr(i, 6))) = arr(i, 10)
    
32. 
    
33.                 d(k)(arr(i, 9)) = crr
    
34. 
    
35.                 Erase crr
    
36. 
    
37.             Else
    
38. 
    
39.                 temp = d(k)(arr(i, 9))
    
40. 
    
41.                 temp(1, d1(arr(i, 6))) = arr(i, 10)
    
42. 
    
43.                 d(k)(arr(i, 9)) = temp
    
44. 
    
45.             End If
    
46. 
    
47.         Next i
    
48.         r = .Cells(Rows.Count, 2).End(xlUp).Row
    
49.         'r = .Cells.Find("*", Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row
    
50. 
    
51.         brr = .Range("b1:i" & r)
    
52. 
    
53.         .[n6:u60000] = ""
    
54. 
    
55.         For i = 6 To UBound(brr)
    
56. 
    
57.             temp = .Cells(i, 2).MergeArea.Address
    
58. 
    
59.             temp = Split(temp, "$")(4)
    
60. 
    
61.             For j = i To temp
    
62. 
    
63.                 k = brr(i, 1) & "," & brr(i, 2) & "," & brr(i, 3) & "," & brr(i, 4)
    
64. 
    
65.                 If Not IsEmpty(d(k)) Then
    
66.                     .Cells(j, "N").Resize(1, 8) = d(k)(brr(j, 7))
    
67.                 End If
    
68. 
    
69.             Next j
    
70. 
    
71.             i = temp
    
72. 
    
73.         Next i
    
74. 
    
75.     End With
    
76. 
    
77.     Application.ScreenUpdating = True
    
78. End Sub
    

复制代码