VBA转VSTO不成功，调试后发现brr数组为UNLL

纵鹤擒龙水中月

初学VSTO，多次调试自身能力解决不了，特求助，看问题出在什么地方，谢了谢了
这个功能就是按耗用量拆分单据列表。VBA代码已在附件中

原VBA代码

1. Sub 单据拆分()    '
   
2.     On Error Resume Next
   
3.     Application.ScreenUpdating = False
   
4.     Application.Calculation = xlManual
   
5.     Dim r&, i&
   
6.     Dim arr, brr, crr, k1, t1
   
7.     Dim d As Object
   
8.     'Dim d2 As Object
   
9.     Msg = MsgBox("提示：按确定执行，否则按取消退出！--------", vbOKCancel + vbDefaultButton2, "提示")
   
10.     '如果按“确定”键，那么执行下面代码
    
11.     If Msg = vbOKCancel Then
    
12.         Set d = CreateObject("scripting.dictionary")
    
13.         Sheets("拆分数量").Select
    
14.         wr = Cells(Rows.Count, 1).End(3).Row
    
15.         crr = Sheets("拆分数量").Range("A2:L" & wr).Value
    
16.         
    
17.         '遍历
    
18.         For i = 1 To UBound(crr)
    
19.             xm = crr(i, 1)  '
    
20.             d(xm) = crr(i, 11) '
    
21.         Next
    
22.         'd1 = d.keys
    
23.         't1 = d.items
    
24. 
    
25.         Sheets("要拆分的单据").Select
    
26.         With Worksheets("要拆分的单据")
    
27.             r = .Cells(.Rows.Count, 1).End(xlUp).Row '
    
28.             arr = .Range("A2:AW" & r).Value '
    
29.             
    
30.             ReDim brr(1 To UBound(arr), 1 To 1)
    
31.             For i = 1 To UBound(arr)
    
32.                 xm = arr(i, 1) '
    
33.                 If d.exists(xm) Then
    
34.                     If d(xm) >= 0 Then
    
35.                         If arr(i, 24) < d(xm) Then '
    
36.                             '
    
37.                             brr(i, 1) = arr(i, 24)
    
38.                         Else
    
39.                            
    
40.                             brr(i, 1) = d(xm) '
    
41.                         End If
    
42.                         d(xm) = d(xm) + arr(i, 24) * -1
    
43.                         
    
44.                     End If
    
45.                 End If
    
46.             Next
    
47.             Range("AW2:AW" & r).ClearContents '耗用数量 列
    
48.             .Range("AW2").Resize(UBound(brr), 1) = brr
    
49.         End With
    
50.         '否则
    
51.     Else
    
52.         '退出程序
    
53.         Exit Sub
    
54.     End If
    
55.     Application.Calculation = xlAutomatic
    
56.     Application.ScreenUpdating = True
    
57. End Sub
    

复制代码

现在转VSTO的代码

1. Sub 单据拆分()    '
   
2.            
   
3.       On Error Resume Next
   
4.   
   
5.        xlApp.ScreenUpdating = False
   
6.       
   
7.        xlApp.Calculation = xlManual
   
8.       
   
9.     Dim r&, i&
   
10.               
    
11.     Dim arr, brr, crr, k1, t1
    
12.             
    
13.     Dim d As New Dictionary(Of String, String)
    
14. 
    
15.   
    
16.         
    
17.       Msg = MsgBox("提示：按确定执行，否则按取消退出！-------", vbOKCancel + vbDefaultButton2, "提示")
    
18.         
    
19.     '如果按“确定”键，那么执行下面代码
    
20.          
    
21.       If Msg = vbOKCancel Then
    
22.             
    
23.            xlApp.Sheets("拆分数量").Select
    
24.      
    
25.           wr =  xlApp.Cells( xlApp.Rows.Count, 1).End(Excel.XlDirection.xlUp).Row
    
26.          
    
27.           crr =  xlApp.Sheets("拆分数量").Range("A2:L" & wr).Value
    
28.          
    
29.          
    
30.    
    
31.         '遍历
    
32.      
    
33.           For i = 1 To UBound(crr)
    
34.         
    
35.               xm = crr(i, 1)  '
    
36.            
    
37.               d(xm) = crr(i, 11) '
    
38.         
    
39.           Next
    
40.               
    
41.         'd1 = d.keys
    
42.         
    
43.         't1 = d.items
    
44.       
    
45.          
    
46.    
    
47.          
    
48.    
    
49.          
    
50.    
    
51.            xlApp.Sheets("要拆分的单据").Select
    
52.      
    
53.           With  xlApp.Worksheets("要拆分的单据")
    
54.    
    
55.               r = .Cells(.Rows.Count, 1).End(xlUp).Row '
    
56.               
    
57.               arr = .Range("A2:AW" & r).Value '
    
58.          
    
59.               
    
60.               
    
61.               ReDim brr(0 To UBound(arr)-1, 0 To 0)
    
62.       
    
63.               For i = 1 To UBound(arr)
    
64.    
    
65.                   xm = arr(i, 1) '
    
66.         
    
67.                   If d.ContainsKey(xm) Then
    
68.    
    
69.                       If d(xm) >= 0 Then
    
70.   
    
71.                           If arr(i, 24) < d(xm) Then '
    
72.   
    
73.                             '
    
74.             
    
75.                               brr(i-1, 1) = arr(i, 24)
    
76.    
    
77.                           Else
    
78.             
    
79.                               
    
80.             
    
81.                               brr(i-1, 1) = d(xm) '
    
82.       
    
83.                           End If
    
84.          
    
85.                           d(xm) = d(xm) + arr(i, 24) * -1
    
86.             
    
87.                           
    
88.   
    
89.                       End If
    
90.               
    
91.                   End If
    
92.    
    
93.               Next
    
94.          
    
95.                xlApp.Range("AW2:AW" & r).ClearContents '耗用数量 列
    
96.               
    
97.               .Range("AW2").Resize(UBound(brr), 1) = brr
    
98.               
    
99.           End With
    
100.          
     
101.         '否则
     
102.      
     
103.       Else
     
104.    
     
105.         '退出程序
     
106.      
     
107.           Exit Sub
     
108.          
     
109.       End If
     
110.   
     
111.        xlApp.Calculation = xlAutomatic
     
112.    
     
113.        xlApp.ScreenUpdating = True
     
114.         
     
115.   End Sub
     
116.      
     

复制代码

1. 
   

复制代码

附件.rar (22.83 KB, 下载次数: 3)

2022-5-11 16:14 上传

点击文件名下载附件

临沂-枸杞

你vsto代码没发成功啊,就一句

纵鹤擒龙水中月

临沂-枸杞 发表于 2022-5-11 21:53
你vsto代码没发成功啊,就一句

嗯，粘贴没有成功，我重新粘贴一下

纵鹤擒龙水中月

请大家指点一下，谢谢！

shenjianrong163

.Range("AW2").Resize(UBound(brr), 1) = brr 这句改为：
.Range("AW2").Resize(UBound(brr), 1).Value = brr