防止按钮多次点击数据重复复制

ztsss161511

本人小白。
之前大佬们给做一个VBA，实现了从“当班”文件复制数据到“台帐”功能。但现在有一个问题，但如果误操作多次点击按钮后会多次复制数据，造成重复。能不能做一个功能：如果表里边已经复制过一遍了数据，再次点击按钮提示数据已经存在然后结束，防止按钮多次点击数据重复复制。

zxsea_7426

aman1516

按钮点击后即转不可用 Enabled = False，在其他地方再触发或手动启用，以确认“每次操作”仅限一次

3190496160

Sub 一键复制()
    Application.ScreenUpdating = False
    Dim n, k, k1, pasths As Integer
    Dim wb As Workbook
    Dim rn As Range
    With Sheet1
        r = .Range("A65536").End(xlUp).Row
        If r < 3 Then MsgBox "数据源为空！": End
        ar = .Range("A4:I" & r)
    End With
    paths = ThisWorkbook.Path & "\"
    f = Dir(paths & "台帐.xls*")
    If f = "" Then MsgBox "找不到台账文件！": End
    Set wb = Workbooks.Open(paths & f, 0)
    With wb.Worksheets(1)
        k = .Cells(Rows.Count, 3).End(xlUp).Row + 1
        Set rn = .Range("b3:b" & k - 1).Find(Date, , , , , , 1)
       If Not rn Is Nothing Then MsgBox "不能重复录入！": wb.Close False: End
        .Cells(k, 3).Resize(UBound(ar), UBound(ar, 2)) = ar
        .Cells(k, 1).Resize(UBound(ar), UBound(ar, 2) + 2).Borders.LineStyle = 1
        For i = k To k + UBound(ar) - 1
            .Cells(i, 1) = i - 2
            .Cells(i, 2) = Date
        Next i
    End With
    wb.Close True '保存并退出
    Application.ScreenUpdating = True
    MsgBox "导入完毕！", 64, "提醒"
End Sub

3190496160

3190496160

台帐.rar (41.07 KB, 下载次数: 6)

2023-2-7 09:16 上传

点击文件名下载附件

3190496160

既然要写入当天日期，那就可以根据当天日期来判断是否重复，