我有一个脚本,它正在格式化原始数据并将其附加到我打开的分析工作簿的末尾。该脚本从分析工作簿运行,因为每次都会填充RAW数据。
脚本工作正常但有一个例外,我无法清除其他工作簿上的剪贴板,我怀疑这是因为它在Excel的另一个实例(应用程序)中打开。
Sub Data_Ready_For_Transfer()
Dim wb As Workbook
Dim ws As Worksheet
Dim rnglog As Range
Dim lastrow As Range
Dim logrange As Range
Dim vlastrow As Range
Dim vlastcol As Range
Dim copydata As Range
Dim pastecell As Range
Dim callno As Range
Set wb = GetObject("Book1")
Set ws = wb.Worksheets("Sheet1")
Application.ScreenUpdating = False
'if we get workbook instance then
If Not wb Is Nothing Then
With wb.Worksheets("Sheet1")
DisplayAlerts = False
ScreenUpdating = False
.Cells.RowHeight = 15
Set rnglog = wb.Worksheets("Sheet1").Range("1:1").Find(What:="Log Date", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
Set lastrow = rnglog.EntireColumn.Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set logrange = wb.Worksheets("Sheet1").Range(rnglog, lastrow)
rnglog.EntireColumn.Offset(0, 1).Insert
rnglog.EntireColumn.Offset(0, 1).Insert
rnglog.EntireColumn.Offset(0, 1).Insert
rnglog.EntireColumn.TextToColumns Destination:=rnglog, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 9)), TrailingMinusNumbers:=True
rnglog.Value = "Log Date"
rnglog.Offset(0, 1).Value = "Time"
logrange.Offset(0, 2).FormulaR1C1 = "=WEEKNUM(RC[-2])"
logrange.Offset(0, 2).EntireColumn.NumberFormat = "General"
rnglog.Offset(0, 2).Value = "Week Number"
logrange.Offset(0, 3).FormulaR1C1 = "=TEXT(RC[-3],""mmmm"")"
logrange.Offset(0, 3).EntireColumn.NumberFormat = "General"
rnglog.Offset(0, 3).Value = "Month"
Set vlastrow = wb.Worksheets("Sheet1").Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set vlastcol = vlastrow.EntireRow.Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious)
Set copydata = .Range("A2", vlastcol)
copydata.Copy
End With
With ActiveWorkbook.Worksheets("RAW Data")
Set pastecell = .Range("A:A").Find(What:="*", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Set callno = .Range("1:1").Find(What:="Call No", LookAt:=xlPart, MatchCase:=False, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
pastecell.Offset(1, 0).PasteSpecial xlPasteValues
.Cells.RemoveDuplicates Columns:=5, Header:=xlYes
Application.CutCopyMode = False
End With
wb.Close False
Application.ScreenUpdating = True
MsgBox "Done"
End If
End Sub
我以为我会通过关闭RAW Data工作簿来解决问题(我还是想这样做)但是我得到一个提示,因为剪贴板数据相当大,所以这也没有用。
答案 0 :(得分:10)
由于工作簿wb
属于另一个应用程序实例,因此您应该使用
wb.Application.CutCopyMode = False
代替
Application.CutCopyMode = False
其中wb.Application
返回工作簿wb
所属的应用程序实例。
答案 1 :(得分:2)
45.2
对我来说无法清除缓冲区或在尝试Application.CutCopyMode = False
时停止出错。粘贴ActiveSheet
。粘贴错误
清除产生errorActiveSheet
的大缓冲区。例如,粘贴错误只是复制一个空单元格,例如ActiveSheet
,其中单元格A1为空或非常小。这将使缓冲区真的很小!轻松修复!也许不完全正确,但功能正确。