Sub CopyData()
Dim wb As Workbook
Dim wsDest As Worksheet
Dim sFilePath As String
Dim aData As Variant
sFilePath = Application.GetOpenFilename("CSV Files, *.csv", MultiSelect:=False)
If sFilePath = "False" Then Exit Sub 'Pressed cancel
Set wb = ActiveWorkbook
Set wsDest = wb.Sheets("Sheet2")
Application.ScreenUpdating = False
With Workbooks.Open(sFilePath)
aData = .Sheets(1).Range("A1", .Sheets(1).Cells(.Sheets(1).Rows.Count, "F").End(xlUp)).Value
.Close False
End With
Application.ScreenUpdating = True
With wsDest.Range("B11").Resize(UBound(aData, 1), UBound(aData, 2))
.Value = aData
.Resize(, 1).NumberFormat = "mm/dd/yyyy" 'Can set date format here, change to dd/mm/yyyy if needed
End With
End Sub
以上是将数据从一个工作簿复制到另一个工作簿的示例代码。
我希望能够在符合IF运算符的特定行上复制特定单元格,为此我希望能够遍历正在打开的CSV文件的每一行以应用逻辑运算符。 / p>
如何修改上述代码才能实现这一目标?
我对VBA不太满意。
答案 0 :(得分:0)
简单的"标准" 方式是在源上应用AutoFilter
并复制可见范围。
Sub CopyData()
Dim wsDest As Worksheet: Set wsDest = ThisWorkbook.Sheets("Sheet2")
Dim sFilePath As String: sFilePath = Application.GetOpenFilename("CSV Files, *.csv", MultiSelect:=False)
If sFilePath = "False" Then Exit Sub 'Pressed cancel
Application.ScreenUpdating = False
On Error GoTo Cleanup
With Workbooks.Open(sFilePath).Sheets(1)
With .Range("A1", .Cells(.Rows.Count, "F").End(xlUp))
.AutoFilter 1, ">" & CDate("1/1/2017") ' <-- Captures dates since year 2017 for example
.SpecialCells(xlCellTypeVisible).Copy
End With
wsDest.Range("B11").PasteSpecial
wsDest.Columns("B").NumberFormat = "mm/dd/yyyy"
.Parent.Close False
End With
Cleanup:
Application.ScreenUpdating = True
End Sub