时间戳

首页 > 解决方案 > 使用 VBA 浏览多个 .csv 文件

excel - 使用 VBA 浏览多个 .csv 文件

问题描述

我正在尝试制作一个可以查看 .csv 文件的 excel 表，然后从该 .csv 文件中复制并粘贴某些信息。我对 .csv 文件一无所知，但在这种情况下，它们的外观和行为就像一个 excel 文件。

这是当前查看单个 .csv 文件 (20180426IM-RV0K6OQH5MA2.csv) 的代码

Sub finder()

Worksheets("Sheet1").Range("A5:J200").Clear

'Use user deffined part number to locate the folder
Dim ParNum As String, FilePath As String, FileName As String
ParNum = Worksheets("Sheet1").Cells(2, "D").Value
FilePath = "R:\Series\Serial No. AC710121\" & ParNum & "\20180426IM-RV0K6OQH5MA2.csv"

'Declare Variables populated excel sheet
Dim Book As Workbook
Dim Brange As Range
Dim Bcell

Set Book = Workbooks.Open(FilePath)
Set Brange = Book.Sheets("20180426IM-RV0K6OQH5MA2").Range("A1:A200")

'Declare Variables for finder excel sheet
Dim Drange As Range
Dim Dcell

Set Drange = ThisWorkbook.Sheets("Sheet1").Range("D5:D205")

'Declare Variables for finder excel sheet
Dim Crange As Range
Dim Ccell

Set Crange = ThisWorkbook.Sheets("Sheet1").Range("C5:C205")

'For loop for printing in Finder
For Each Bcell In Brange

If Bcell.Value = "IT" Then
    Book.Sheets("20180426IM-RV0K6OQH5MA2").Range(Bcell.Offset(0, 2), Bcell.Offset(0, 8)).Copy

    For Each Dcell In Drange
        If IsEmpty(Dcell.Value) = True And IsEmpty(Dcell.Offset(0, -1).Value) = True Then

            ThisWorkbook.Sheets("Sheet1").Range(Dcell.Offset(0, 0), Dcell.Offset(0, 8)).PasteSpecial
        End If
     Next Dcell       
End If
Next Bcell


End Sub

.csv 文件是自动生成的，随着时间的推移，文件夹中会出现多个 .csv 文件。我希望代码能够打开一个 .csv 文件，执行它的操作，然后打开下一个 .csv 文件并重复，直到浏览完文件夹中的所有 .csv 文件。

另外，有没有办法将变量声明为正在查看的文件的名称，并使该文件中的工作表等于变量名称？例如，如果文件名为“Bob”，我想声明一个变量“Bob”，以便告诉代码此工作簿中的工作表也称为“Bob”。

我希望这足够清楚。谢谢你的帮助！

标签： excelvbacsv

解决方案

这是正确执行我所要求的代码：

Sub finder()

Application.ScreenUpdating = False
Application.EnableEvents = False

Worksheets("Sheet1").Range("A5:J200").Clear

'Use user deffined part number to locate the file
Dim ParNum As String, FilePath As String, FileName As String
ParNum = Worksheets("Sheet1").Cells(2, "D").Value

'Variable that represents the file name
File = Dir("R:\Series\Serial No. AC710121\" & ParNum & "\*.csv")

'Looks through all the .csv files in the folder
Do While File <> ""

     'Variable that represents the name within the file
     SheetVar = Left(File, 23)
     'Variable that represents the file path to the file
     FilePath = "R:\Series\Serial No. AC710121\" & ParNum & "\" & File & ""

    'Declare Variables for populated excel sheet
    Dim Book As Workbook
    Dim Krange As Range
    Dim Kcell

    Set Book = Workbooks.Open(FilePath)
    Set Krange = Book.Sheets(SheetVar).Range("A1:A200")

    'Declare Variables for finder excel sheet (Column D)
    Dim Drange As Range
    Dim Dcell

    Set Drange = ThisWorkbook.Sheets("Sheet1").Range("D5:D205")

    'Declare Variables for finder excel sheet (Column C)
    Dim Crange As Range
    Dim Ccell

    Set Crange = ThisWorkbook.Sheets("Sheet1").Range("C5:C205")

    'For loop for copying the information and pasting it in Finder
    For Each Kcell In Krange

        If Kcell.Value = "IT" Then
            Book.Sheets(SheetVar).Range(Kcell.Offset(0, 2), Kcell.Offset(0, 8)).Copy

            For Each Dcell In Drange
                 If IsEmpty(Dcell.Value) = True And IsEmpty(Dcell.Offset(0, -1).Value) = True Then

                     ThisWorkbook.Sheets("Sheet1").Range(Dcell.Offset(0, 0), Dcell.Offset(0, 8)).PasteSpecial

                    If Dcell.Offset(0, 6).Value = "OK" Then
                        Range(Dcell.Offset(0, 0), Dcell.Offset(0, 6)).Interior.Color = RGB(113, 221, 131)
                    End If

                    If Dcell.Offset(0, 6).Value <> "OK" And IsEmpty(Dcell.Offset(0, 6).Value) = False Then
                        Range(Dcell.Offset(0, 0), Dcell.Offset(0, 6)).Interior.Color = RGB(221, 100, 120)
                    End If

                    Exit For

                 End If

            Next Dcell

        End If

        If Kcell.Value = "DA" Then
            Book.Sheets(SheetVar).Range(Kcell.Offset(0, 1), Kcell.Offset(0, 1)).Copy

            For Each Ccell In Crange
                If IsEmpty(Ccell.Value) = True And IsEmpty(Ccell.Offset(0, 1).Value) = True Then
                    ThisWorkbook.Sheets("Sheet1").Range(Ccell.Offset(0, 0), Ccell.Offset(0, 0)).PasteSpecial
                    Exit For
                End If
            Next Ccell

        End If

    Next Kcell

    Workbooks(File).Close SaveChanges = False

    File = Dir

Loop

Range("C2:J200").HorizontalAlignment = xlCenter
'Range("F5:F200").Sort Key1:=Range("F5"), Order1:=xlAscending, Header:=xlNo

End Sub

如果某些变量不同，我很抱歉，但这应该能够突出我为使代码执行我想要的操作而实施的更改。我认为有一种更优雅的方式来完成这项任务，这正是我想出的。

此代码能够执行以下操作：

它需要用户提供的零件编号，然后使用该编号查找文件夹，然后查看所述文件夹中的每个 .csv 文件。它遍历 .csv 文件并复制某些信息，然后将其粘贴到保存代码的工作簿中。

希望这可以帮助某人。

推荐阅读