我可以使用录制的宏在工作簿之间选择复制/粘贴。工作正常但是,在阅读时,我正在学习一种更快的方法,该方法不涉及复制/粘贴剪贴板。希望有人可以教我钓鱼。
让我解释发生了什么。
就是这样。
我在2000年对行进行了四舍五入,因为这是一个安全的押注,数据不会通过该行。但是,我知道有更好的方法。当前,我收到438错误对象不支持此属性或方法。也许您可以帮助阐明这一点。
我将在过程中附加带有rem语句的vba代码副本。先感谢您。我只是在学习stackoverflow设置,希望我能付钱。谢谢,Boomer
`Sub import_data()
'
' import_data Macro
Dim wb1 As Workbook
Application.ScreenUpdating = False
'Using FILE-OPEN text file and run thru text delimited setup
Workbooks.OpenText (Module33.FileDir + "\cf_data.txt"), Origin:=437, _
StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _
, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), _
Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1)),
TrailingMinusNumbers:=True
'Applying the newly open excel workbook (text file)to a variable wb1
Set wb1 = ThisWorkbook
'Switching to the first sheet within this wb1 workbook
With wb1.Sheets(1)
'Selecting Columns A thru G and all rows in each columns that have
'values. text or numbers, no formulas.
lr = .Range("A:G").Find(what:="*", after:=.Range("A1"),
searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
.Range(.Cells(2, "A"), .Cells(lr, "G")).Value '<====Run-time 438 '- Object doesn't support this property or method
End With
wb1.Close SaveChanges:=False
'Switches back to main workbook to sheet 2 then range B6 and paste
'all data
Workbooks("Auto_Data.xlsm").Sheet2.Range("B6").Resize(UBound(arr,
1), UBound(arr, 2)) = arr
'The code below does what I'm wanting however, it is very sluggish. This
'code, when in use, will sit just below text delimited section.
' Range("A2:G2000").Select
' Selection.Copy
' Windows("Auto_Data.xlsm").Activate
' Sheet2.Select
' Range("B6:H6").Select
' ActiveSheet.Paste
' Selection.AutoFilter
' Application.CutCopyMode = False
' ActiveWindow.ActivateNext
' ActiveWindow.Close
' Range("B4").Select
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:1)
因此,这是一个简单的示例,可让您适应自己的需求。您需要注意的是要清楚您对哪个工作簿,工作表和范围的引用。在此示例中,唯一要复制的是数据。使用复制/粘贴更适合同时复制数据和嵌入式格式(这不适用于您的情况)。
Option Explicit
Sub ImportData()
Dim destWB As Workbook
Set destWB = ThisWorkbook
Dim textWB As Workbook
Dim textWS As Worksheet
Workbooks.OpenText "C:\Temp\testdata.txt", Space:=True
Set textWB = ActiveWorkbook
If textWB Is Nothing Then
MsgBox "Unable to open the text data"
Exit Sub
Else
Set textWS = textWB.Sheets(1)
End If
'--- determine the data range and copy to a memory-based array
Dim lastRow As Long
Dim lastCol As Long
Dim textArea As Range
Dim textData As Variant
With textWS
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
Set textArea = .Range("A1").Resize(lastRow, lastCol)
textData = textArea
End With
Dim destWS As Worksheet
Dim destArea As Range
Set destWS = destWB.Sheets("Sheet1")
Set destArea = destWS.Range("A1").Resize(lastRow, lastCol)
destArea = textData
textWB.Close SaveChanges:=False
End Sub
编辑:更新了答案,以解决OP中的问题 评论。
Sub ImportData2()
Dim destWB As Workbook
Set destWB = ThisWorkbook
Dim textWB As Workbook
Dim textWS As Worksheet
Workbooks.OpenText "C:\Temp\testdata.txt", Space:=True
Set textWB = ActiveWorkbook
If textWB Is Nothing Then
MsgBox "Unable to open the text data"
Exit Sub
Else
Set textWS = textWB.Sheets(1)
End If
Dim destWS As Worksheet
Set destWS = destWB.Sheets("Sheet1")
'--- first range to copy A2:A<lastRow> to destWS A2
CopyData textWS, 1, 1, destWS, "A2"
'--- second range to copy E2:E<lastRow> to destWS E2
CopyData textWS, 5, 1, destWS, "E2"
'--- third range to copy G2:J<lastRow> to destWS G2
CopyData textWS, 7, 4, destWS, "G2"
textWB.Close SaveChanges:=False
End Sub
Private Sub CopyData(ByRef srcWS As Worksheet, _
ByVal startColumn As Long, _
ByVal numberOfColumns As Long, _
ByRef destWS As Worksheet, _
ByVal destCell As String)
Dim lastRow As Long
Dim textArea As Range
Dim textData As Variant
With srcWS
lastRow = .Cells(.Rows.Count, startColumn).End(xlUp).Row
Set textArea = .Cells(2, startColumn).Resize(lastRow, numberOfColumns)
textData = textArea
End With
Dim destArea As Range
Set destArea = destWS.Range(destCell).Resize(textArea.Rows.Count, _
textArea.Columns.Count)
destArea = textData
End Sub