[已解决]VBA重覆批号问题

lkk0063 · 发表于 2016-12-21 10:23

本帖最后由 lkk0063 于 2016-12-21 16:09 编辑

请问如何使用VBA实现以下功能
按下"Add Data"按钮，"In" Sheet G2 栏位会自动与"Out" Sheet A:A 栏位比对是否有相同，若有相同批号，则无法输出至"Out" Sheet，并秀出讯息

最佳答案

月排行榜 / 总排行榜

grf1973

2016-12-21 15:27

加了注释。

Function 判断重复() As Boolean '“判断重复”作为一个逻辑型的函数，如果重复，值为true,否则为false
Dim d, arr, i, lotno
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Out").Range("a1:a" & Sheets("Out").[a65536].End(3).Row) '工作表"Out"的A列作为数据源
For i = 5 To UBound(arr) '有效数据从第5行开始
d(arr(i, 1)) = "" '把LotNo(arr(i,1))放入字典
Next
lotno = Left([g2], 13) '本表的LotNo
If d.exists(lotno) Then MsgBox "Same LotNo in Out": 判断重复 = True '如果本表的LotNo在字典中存在，说明有重复，那么函数“判断重复”值为true，并消息框提示。
End Function

复制代码

跳转到最佳答案楼层

sgxb123431380 · 发表于 2016-12-21 11:22

Private Sub CommandButton1_Click()
Set sh = Sheets("In")
G2 = sh.[G2].Value
OutCount = Sheets("Out").Range("A" & Rows.Count).End(xlUp).Row
If OutCount > 5 Then
OutData = Sheets("Out").Range("A6").Resize(OutCount - 5, 82).Value
For j = 1 To UBound(OutData, 1)
If OutData(j, 1) = G2 Then Exit For
Next j
If j = UBound(OutData, 1) + 1 Then GoTo Ins
InData = sh.Range("F4:J18").Value
Ti = Array("G2", "C1", "E1", "G1", "E2", "C2", "I1", "K1", "C3", "E3")
For i = 1 To 82
If i <= 10 Then
sh.Range(Ti(i - 1)).Value = OutData(j, i)
Else
InData(Int((i - 11) / 5) + 1, (i - 11) Mod 5 + 1) = OutData(j, i)
End If
Next i
sh.Range("F4:J18").Value = InData
Else
OutData = Sheets("Out").Range("A6").Resize(1, 82).Value
Ins:
InData = sh.Range("F4:J18").Value
Ti = Array(G2, sh.[C1].Value, sh.[E1].Value, sh.[G1].Value, sh.[E2].Value, sh.[C2].Value, sh.[I1].Value, sh.[K1].Value, sh.[C3].Value, sh.[E3].Value)
For i = 1 To 82
If i <= 10 Then
OutData(1, i) = Ti(i - 1)
Else
OutData(1, i) = InData(Int((i - 11) / 5) + 1, (i - 11) Mod 5 + 1)
End If
Next i
Sheets("Out").Range("A" & OutCount + 1).Resize(1, 82).Value = OutData
End If
End Sub

复制代码

sgxb123431380 · 发表于 2016-12-21 11:23

sgxb123431380 发表于 2016-12-21 11:22

给你全部重新写了

grf1973 · 发表于 2016-12-21 11:25

考虑到不影响原代码，加个函数判断一下。

Function 判断重复() As Boolean
Dim d, arr, i, lotno
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Out").Range("a1:a" & Sheets("Out").[a65536].End(3).Row)
For i = 5 To UBound(arr)
d(arr(i, 1)) = ""
Next
lotno = Left([g2], 13)
If d.exists(lotno) Then MsgBox "Same LotNo in Out": 判断重复 = True
End Function

复制代码

然后在原代码开头加一句：
If 判断重复 = True Then Exit Sub

lkk0063 · 发表于 2016-12-21 13:26

grf1973 发表于 2016-12-21 11:25
考虑到不影响原代码，加个函数判断一下。

然后在原代码开头加一句：

Hi grf1973,
可以使用了, 谢谢, 但我想了解一下程式码,以下对于程式码解析是否有误，麻烦了

1.Function 判断重复() As Boolean
'Function判断式写法?

2.arr = Sheets("Out").Range("a1:a" & Sheets("Out").[a65536].End(3).Row)
'这是指抓取Sheets("Out") A:A 栏位所有资料吗?

3. For i = 5 To UBound(arr)'从5开始到数组的最大上界值之间循环
'从5开始到数组的最大上界值之间循环

4. d(arr(i, 1)) = ""
'将关键字" "(空白)资料丢进 arr(i,1)

5.If d.exists(lotno) Then MsgBox "Same LotNo in Out": 判断重复 = True
'如果字典中存在关键字"lotno”，秀出Same LotNo in Out讯息

lkk0063 · 发表于 2016-12-21 13:28

sgxb123431380 发表于 2016-12-21 11:23
给你全部重新写了

sgxb123431380
谢谢你的帮忙,
但grf1973 大大比较符合我的需求, 须不影响原代码状态下, 不好意思

sgxb123431380 · 发表于 2016-12-21 13:42

lkk0063 发表于 2016-12-21 13:28
sgxb123431380
谢谢你的帮忙,
但grf1973 大大比较符合我的需求, 须不影响原代码状态下, 不好意思

没事，写着玩的，就是看你有好多对单元格的直接调用就给你改了一下，能加快一些速度而已

grf1973 · 发表于 2016-12-21 15:27

这个最佳答案由 grf1973 给出，感谢 grf1973 的回答。

单击隐藏图章

加了注释。

Function 判断重复() As Boolean '“判断重复”作为一个逻辑型的函数，如果重复，值为true,否则为false
Dim d, arr, i, lotno
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Out").Range("a1:a" & Sheets("Out").[a65536].End(3).Row) '工作表"Out"的A列作为数据源
For i = 5 To UBound(arr) '有效数据从第5行开始
d(arr(i, 1)) = "" '把LotNo(arr(i,1))放入字典
Next
lotno = Left([g2], 13) '本表的LotNo
If d.exists(lotno) Then MsgBox "Same LotNo in Out": 判断重复 = True '如果本表的LotNo在字典中存在，说明有重复，那么函数“判断重复”值为true，并消息框提示。
End Function

复制代码

		自动登录	找回密码
密码			注册

[已解决]VBA重覆批号问题

相关帖子