VBA按单号获取数据打印单问题

qwasd3

附档《加工单记录》表，鼠标定位到D列”加工单号“单元格，点击上面 ”加工单“按钮，将对应加工单号数据抓到右边《加工单》表对应栏位，形成单据打印。
目前VBA代码在 Excel2010里测试无问题，但在Excel2013里只能抓取第一笔记录，如果这个订单有多笔只能抓第一笔，不知问题在哪？
请教大神们帮看看。。

打印单据.rar (47.02 KB, 下载次数: 14)

2025-3-14 17:14 上传

点击文件名下载附件

chxw68

我的2016没问题。

qwasd3

chxw68 发表于 2025-3-14 17:18
我的2016没问题。

2013不行，奇怪。。。

ynzsvt

1.   If Sheet4.Range("D" & i) = x001(1) Then '++++++++sheet4

复制代码

ynzsvt

感觉粘贴的时候就自动切换了工作表。

lu咩

wps12.1.0.16929无问题

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     If ActiveCell.Column = 4 And ActiveCell.Row > 4 Then
   
5.         If ActiveCell.Value <> empth Then
   
6.             xm = ActiveCell.Value
   
7.             With Worksheets("加工单记录")
   
8.                 r = .Cells(.Rows.Count, 2).End(xlUp).Row
   
9.                 arr = .Range("b5:u" & r)
   
10.                 ReDim brr(1 To UBound(arr), 1 To 14)
    
11.                 m = 0
    
12.                 For i = 1 To UBound(arr)
    
13.                     If arr(i, 3) = xm Then
    
14.                         m = m + 1
    
15.                         brr(m, 1) = arr(i, 4)
    
16.                         brr(m, 2) = arr(i, 8)
    
17.                         brr(m, 3) = arr(i, 9)
    
18.                         brr(m, 4) = arr(i, 10)
    
19.                         brr(m, 5) = arr(i, 11)
    
20.                         brr(m, 6) = arr(i, 12)
    
21.                         brr(m, 7) = arr(i, 13)
    
22.                         brr(m, 8) = arr(i, 14)
    
23.                         brr(m, 9) = arr(i, 15)
    
24.                         brr(m, 10) = arr(i, 16)
    
25.                         brr(m, 11) = arr(i, 17)
    
26.                         brr(m, 12) = arr(i, 18)
    
27.                         brr(m, 13) = arr(i, 19)
    
28.                         brr(m, 14) = arr(i, 20)
    
29.                     End If
    
30.                 Next
    
31.             End With
    
32.             If m > 0 Then
    
33.                 With Worksheets("加工单")
    
34.                     .Range("b8:o19").ClearContents
    
35.                     .Range("b8").Resize(m, UBound(brr, 2)) = brr
    
36.                 End With
    
37.             End If
    
38.         Else
    
39.             MsgBox "活动单元格为空！"
    
40.         End If
    
41.     Else
    
42.         MsgBox "活动单元格不在D列有效范围内！"
    
43.     End If
    
44. 
    
45. End Sub
    

复制代码

chxw68

楼主的代码是录制的吧？重新写了一段供参考。

qwasd3

chxw68 发表于 2025-3-14 18:32
楼主的代码是录制的吧？重新写了一段供参考。

感谢，我试试。。