[已解决]按库位保存

15968725770

按库位保存

最佳答案

月排行榜 / 总排行榜

cutecpu

2022-12-23 17:06

祝順心，南無阿彌陀佛！

跳转到最佳答案楼层

cutecpu

祝順心，南無阿彌陀佛！

15968725770

cutecpu 发表于 2022-12-23 17:06
祝順心，南無阿彌陀佛！

老师你好H4:L4为空提示“输入内容”

要不然会弹出VBA编辑框

okjok

1. Sub 按钮2_Click()
   
2.     With Application
   
3.         .ScreenUpdating = False
   
4.         .DisplayAlerts = False
   
5.     End With
   
6.     Dim arr, dic As Object, x, i, m, ii
   
7.     arr = Range("a4:Q" & [a65536].End(xlUp).Row)
   
8.     Set dic = CreateObject("scripting.dictionary")
   
9.     For x = 1 To UBound(arr)
   
10.         dic(arr(x, 14)) = arr(x, 14)
    
11.     Next
    
12.     For m = 1 To dic.Count
    
13.         ii = 1
    
14.         ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
    
15.         For x = 1 To UBound(arr)
    
16.             If dic(arr(m, 14)) = Cells(x + 3, 14) Then
    
17.                 For i = 1 To UBound(arr, 2)
    
18.                     brr(ii, i) = brr(ii, i) & arr(x, i)
    
19.                 Next
    
20.                 ii = ii + 1
    
21.             End If
    
22.         Next
    
23.         Sheets(dic(arr(m, 14))).[a65536].End(xlUp).Offset(1, 0).Resize(UBound(brr), UBound(arr, 2)) = brr
    
24.         Erase brr
    
25.     Next
    
26.     [a4:Q100000].Clear
    
27.     With Application
    
28.         .ScreenUpdating = True
    
29.         .DisplayAlerts = True
    
30.     End With
    
31. End Sub

复制代码

15968725770

15968725770 发表于 2022-12-23 21:35
老师你好H4:L4为空提示“输入内容”

要不然会弹出VBA编辑框

没有数据录入时，如点了按钮，就会弹出来

cutecpu

15968725770 发表于 2022-12-24 16:30
没有数据录入时，如点了按钮，就会弹出来

了解，因為放假目前沒有電腦可以使用
您嘗試在代碼一開頭加上以下判斷即可

if [a4] ="" then exit sub

15968725770

cutecpu 发表于 2022-12-24 17:00
了解，因為放假目前沒有電腦可以使用
您嘗試在代碼一開頭加上以下判斷即可

谢谢老师

15968725770

15968725770 发表于 2022-12-23 21:35
老师你好H4:L4为空提示“输入内容”

要不然会弹出VBA编辑框

老师你好，指定多个单元格内容生成二维码，能弄吗，二维码大小尺寸可设定，并把二维码入到指定位置