[已解决]添加不重复代码

fangniuji

我每天需要将5S扣分报表输入完成后，按一下“YY”按钮，数据即复制到登记簿里，有时点击两下确认按钮，数据就会

复制两次，从而造成汇总数据出错，怎样在VBA里添加代码，使数据不能重复。谢谢各位了！！

最佳答案

月排行榜 / 总排行榜

grf1973

2014-6-16 16:24

在你的代码上改了一下。

1. Sub GG()
   
2.     Dim i, r1, r2 As Long
   
3.     Dim Flag As Boolean
   
4.    
   
5.     Sheets("登记簿").Rows.Hidden = False
   
6.     Sheets("登记簿").Columns.Hidden = False
   
7.     Flag = True
   
8.     r1 = Sheets("日数据").[V65536].End(xlUp).Row
   
9.     arr = Sheets("日数据").Range("v1:ad" & r1)
   
10.     r2 = Sheets("登记簿").[lx65536].End(xlUp).Row
    
11.     brr = Sheets("登记簿").Range("LX1:MF" & r2)
    
12.     n = UBound(arr) - 2
    
13.     s = r2 - n - 2
    
14.     If s < 0 Then Flag = False: GoTo aa
    
15.     For i = 3 To UBound(arr)
    
16.         For j = 1 To UBound(arr, 2)
    
17.             If arr(i, j) <> brr(s + i, j) Then Flag = False: GoTo aa
    
18.         Next
    
19.     Next
    
20. aa:
    
21.     If Flag = False Then   '如果日数据在登记簿中不存在，复制日数据到登记簿
    
22.         Sheets("日数据").Range("v3:ad" & r1).Copy: Sheets("登记簿").Cells(r2 + 1, 336).PasteSpecial xlPasteValues
    
23.         For i = r2 To Sheets("登记簿").[lx65536].End(xlUp).Row
    
24.             Sheets("登记簿").Cells(i, 335) = i - 2   '自动编号
    
25.         Next i
    
26.         MsgBox "数据保存结束!"
    
27.     Else
    
28.         MsgBox "日数据已存在！"
    
29.     End If
    
30.     Application.CutCopyMode = False
    
31. 
    
32. End Sub
    

复制代码

跳转到最佳答案楼层

qh8600

可以在日数据添加个编号，判断一下登记簿有没有这个编号，没有就保存，有就退出

suye1010

是否可以这样，添加一个计数器，打开的时候初始化为0，运行一次YY后+1，不能再点。只有重新打开文件后才可以点击。
或者，数据复制到等级簿之后，对前面的数据进行清除。

grf1973

在你的代码上改了一下。

1. Sub GG()
   
2.     Dim i, r1, r2 As Long
   
3.     Dim Flag As Boolean
   
4.    
   
5.     Sheets("登记簿").Rows.Hidden = False
   
6.     Sheets("登记簿").Columns.Hidden = False
   
7.     Flag = True
   
8.     r1 = Sheets("日数据").[V65536].End(xlUp).Row
   
9.     arr = Sheets("日数据").Range("v1:ad" & r1)
   
10.     r2 = Sheets("登记簿").[lx65536].End(xlUp).Row
    
11.     brr = Sheets("登记簿").Range("LX1:MF" & r2)
    
12.     n = UBound(arr) - 2
    
13.     s = r2 - n - 2
    
14.     If s < 0 Then Flag = False: GoTo aa
    
15.     For i = 3 To UBound(arr)
    
16.         For j = 1 To UBound(arr, 2)
    
17.             If arr(i, j) <> brr(s + i, j) Then Flag = False: GoTo aa
    
18.         Next
    
19.     Next
    
20. aa:
    
21.     If Flag = False Then   '如果日数据在登记簿中不存在，复制日数据到登记簿
    
22.         Sheets("日数据").Range("v3:ad" & r1).Copy: Sheets("登记簿").Cells(r2 + 1, 336).PasteSpecial xlPasteValues
    
23.         For i = r2 To Sheets("登记簿").[lx65536].End(xlUp).Row
    
24.             Sheets("登记簿").Cells(i, 335) = i - 2   '自动编号
    
25.         Next i
    
26.         MsgBox "数据保存结束!"
    
27.     Else
    
28.         MsgBox "日数据已存在！"
    
29.     End If
    
30.     Application.CutCopyMode = False
    
31. 
    
32. End Sub
    

复制代码

fangniuji

grf1973 发表于 2014-6-16 16:24
在你的代码上改了一下。

谢谢你的帮忙，谢谢！！！！

fangniuji

grf1973 发表于 2014-6-16 16:24
在你的代码上改了一下。

这个报表要如何添加代码语句：让代码不重复复制。谢谢！！！！

grf1973

输入界面中判断前三行所有项字符串累加是否和登记簿最后一条记录的对应项字符串累加相同。

fangniuji

grf1973 发表于 2014-6-19 15:35
输入界面中判断前三行所有项字符串累加是否和登记簿最后一条记录的对应项字符串累加相同。

http://www.excelpx.com/thread-327179-1-1.html谢谢你，你把答案放在这链接，我给你一个“OK”。