2017-02-18 95 views
0
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 

上面是将数据从一个工作簿复制到另一个的示例代码。VBA - Excel - 解析CSV并迭代每行

我希望能够复制符合IF运算符的特定行上的特定单元格,并且我希望能够遍历正在打开的CSV文件的每一行以应用逻辑运算符。

如何修改上述代码以实现该目的?

我对VBA不太好。

回答

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