Sub baocun()
On Error Resume Next
Dim arr, ar, i As Long, j As Long, str As String
str = Sheets("走读登记窗口").Range("C2").Value
arr = Sheets("走读库").Range("c:c").CurrentRegion
For i = 1 To UBound(arr)
If Dir(arr) <> str Then
With Sheets("走读登记窗口")
ar = Array(.[i2], .[c2], .[c4], .[c6], .[g4], .[g6], .[g8], .[g10], .[a20], .[c20], .[e20], .[g20], .[i20])
End With
With Sheets("走读库")
.Range("b65536").End(3).Offset(1, 0).Resize(1, 12) = ar
End With
MsgBox "已加入走读列表"
ElseIf Dir(arr) = str Then
With Sheets("走读登记窗口")
ar = Array(.[i2], .[c2], .[c4], .[c6], .[g4], .[g6], .[g8], .[g10], .[a20], .[c20], .[e20], .[g20], .[i20])
End With
With Sheets("走读库")
.Range("b65536").End(3).Offset(1, 0).Resize(1, 12) = ""
End With
MsgBox "已存在走读列表"
End If
Exit For
Next
End Sub
|