Question

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不太满意。

Answer 1

简单的＆＃34;标准＆＃34; 方式是在源上应用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

VBA - Excel - 解析CSV并遍历每一行

1 个答案: