VBA代码添加判断

天真无鞋

VBA代码添加判断，详见附加信息。



1、如果F3单元格和E3单元格不一致时，检验项目无法获取【数据来源Reference test items】,需帮忙增加判断代码，如果F3单元格和E3单元相同则允许引用工作表【Reference test items】里面的数据。
2、如果F3单元和E3单元不一致时，需重新点击保存后可获取，帮忙增加判断代码。【注：当F3单元和E3单元相同时不允许保存，保存信息不可重复需单独提行】

ykcbf1100

附件供参考。。。

天真无鞋

ykcbf1100 发表于 2024-4-18 20:30
附件供参考。。。

显示内存不足

ykcbf1100

天真无鞋 发表于 2024-4-18 21:08
显示内存不足

明天看一下。

ykcbf1100

天真无鞋 发表于 2024-4-18 21:08
显示内存不足

是你写的代码有问题，我重写了代码。

ykcbf1100

代码供参考。。。

1. Sub Save4()
   
2.     '检验项目保存
   
3.     Application.ScreenUpdating = False
   
4.     Set d = CreateObject("Scripting.Dictionary")
   
5.     With Sheets("Reference test items")
   
6.         r = .Cells(rows.Count, 1).End(3).Row
   
7.         arr = .[a1].Resize(r, 1)
   
8.         For i = 2 To UBound(arr)
   
9.             s = arr(i, 1)
   
10.             d(s) = ""
    
11.         Next
    
12.     End With
    
13.     With Sheets("FQC inspection")
    
14.         If .[f3] = "" Or .[e3] = "" Then
    
15.             MsgBox "The information is incomplete and cannot be saved!"
    
16.             Exit Sub
    
17.         End If
    
18.         st = CStr(.[f3].Value)
    
19.         If d.exists(st) Then
    
20.             MsgBox "产品型号和版本已重复"
    
21.             Exit Sub
    
22.         End If
    
23.         ReDim brr(1 To 26)
    
24.         brr(1) = .Range("f3").Value
    
25.         brr(2) = .Range("e3").Value
    
26.         brr(3) = .Range("a17").Value
    
27.         brr(4) = .Range("b17").Value
    
28.         brr(5) = .Range("c17").Value
    
29.         brr(6) = .Range("d17").Value
    
30.         brr(7) = .Range("e17").Value
    
31.         brr(8) = .Range("f17").Value
    
32.         brr(9) = .Range("g17").Value
    
33.         brr(10) = .Range("a19").Value
    
34.         brr(11) = .Range("b19").Value
    
35.         brr(12) = .Range("c19").Value
    
36.         brr(13) = .Range("d19").Value
    
37.         brr(16) = .Range("e19").Value
    
38.         brr(19) = .Range("f19").Value
    
39.         brr(20) = .Range("g19").Value
    
40.         brr(21) = .Range("a21").Value
    
41.         brr(22) = .Range("b21").Value
    
42.         brr(25) = .Range("c21").Value
    
43.         brr(26) = .Range("d21").Value
    
44.     End With
    
45.     With Sheets("Reference test items")
    
46.         r = .Cells(rows.Count, 1).End(3).Offset(1).Row
    
47.         For x = 1 To 26
    
48.             .Cells(r, x) = brr(x)
    
49.         Next
    
50.     End With
    
51.     MsgBox "OK！"
    
52. End Sub
    

复制代码