Pet*_*y87 6 excel vba excel-vba
我有一个脚本,它正在格式化原始数据并将其附加到我打开的分析工作簿的末尾.该脚本从分析工作簿运行,因为每次都会填充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
Run Code Online (Sandbox Code Playgroud)
我以为我会通过关闭RAW Data工作簿来解决这个问题(我还是想这样做)但是我得到一个提示,因为剪贴板数据相当大,所以这也行不通.
Dmi*_*liv 11
由于工作簿wb属于另一个应用程序实例,因此您应该使用
wb.Application.CutCopyMode = False
Run Code Online (Sandbox Code Playgroud)
代替
Application.CutCopyMode = False
Run Code Online (Sandbox Code Playgroud)
其中,wb.Application返回该工作簿的应用实例wb属于.
我要做的就是在粘贴了先前复制的值之后就复制了ActiveWorkbook中的任何空白单元格,而我不再需要它们了-这会将剪贴板中的大数据替换为空字符串(相对而言没有),并且允许我在需要时关闭工作簿。
我知道这是一种解决方法,但它始终有效。
另一种解决方案
您应该尝试获取MSForms DataObject并将其放入剪贴板
Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
Run Code Online (Sandbox Code Playgroud)
然后清除它,如下所示:
clipboard.Clear
Run Code Online (Sandbox Code Playgroud)
如果这不起作用,您可以始终将剪贴板文本设置为空
clipboard.SetText ""
clipboard.PutInClipboard
Run Code Online (Sandbox Code Playgroud)