Question

我正在尝试创建一个可以浏览.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”。

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

Answer 1

这是执行我正确询问的代码：

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文件并复制某些信息，然后将其粘贴到保存代码的工作簿中。

希望这可以帮助某些人。

使用VBA查看多个.csv文件

1 个答案: