EXCEL.VBA-查重、保存、清表代码片段

原创于 2024-12-19 13:11:19 发布 · 214 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#excel

MS 专栏收录该内容

3 篇文章

订阅专栏

Sub Saveto01()
 Application.ScreenUpdating = False
 Dim iCountA As Integer,iCountB As Integer,Check_001 As Integer,Check_002 As Integer
 Dim rng As Range,cell As Range
 Worksheets("INPUT").Cells(4, 4) = 1
 MsgBox "开始？", 64
 check_001 = Worksheets("INPUT").Cells(16, 6)
    If check_002 = 0 Then
        Sheets("DATABASE").Select
        ActiveSheet.Unprotect password:="passw"
        Sheets("INPUT").Select
        ActiveSheet.Unprotect password:="passw"
        iCountB = WorksheetFunction.CountA([a6:a15])
        i = 1
        For i = 1 To iCountB
           Sheets("INPUT").Select
           Range("A" & 5 + i & ":" & "D" & 5 + i).Select
           Selection.Copy
           Range("A51:D51").Select
           Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
               True, Transpose:=False
           Worksheets("INPUT").Cells(5, 51).Calculate
           Range("A51:F51").Select
           Selection.Copy
           Sheets("DATABASE").Select
           iCountA = Range("A65536").End(xlUp).Row
           Range("A" & iCountA + 1 & ":" & "F" & iCountA + 1).Select
           Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
               True, Transpose:=False
           Next i
        Sheets("DATABASE").Activate
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
               False, password:="passw"
        Sheets("INPUT").Select
        Range("A6:D15").Select
        Selection.ClearContents
        ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
               False, password:="passw"
        Range("A6").Select
        Exit Sub
    Else
        MsgBox "有" & check_002 & "张发票有问题，请检查", 16
    End If
 Worksheets("INPUT").Cells(4, 4) = 0
 Call uptimes
End Sub