Excel 使用VBA查看多个.csv文件

我正在尝试制作一个excel工作表，可以查看.csv文件，然后从该.csv文件复制并粘贴某些信息。我对.csv文件一无所知，但在本例中，它们的外观和行为类似于excel文件

以下是当前查看单个.csv文件（20180426IM-RV0K6OQH5MA2.csv）的代码

.csv文件是自动生成的，随着时间的推移，文件夹中会有多个.csv文件。我希望代码能够打开一个.csv文件，完成它的工作，然后打开下一个.csv文件并重复，直到文件夹中的所有.csv文件都被查看完毕

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

---

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

以下代码正确地完成了我的问题：

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

Sub finder（）
Application.ScreenUpdating=False
Application.EnableEvents=False
工作表（“表1”）。范围（“A5:J200”）。清除
'使用用户定义的零件号定位文件
Dim ParNum作为字符串，FilePath作为字符串，FileName作为字符串
ParNum=工作表（“表1”）.单元格（2，“D”）.值
'表示文件名的变量
File=Dir（“R:\Series\Serial No.AC710121\”&ParNum&“\*.csv”）
'查找文件夹中的所有.csv文件
文件“”时执行此操作
'变量，该变量表示文件中的名称
SheetVar=Left（文件，23）
'变量，表示文件的文件路径
FilePath=“R:\Series\Serial No.AC710121\”&ParNum&“\”&File&“
'为填充的excel工作表声明变量
将书籍作为工作簿
暗Krange作为射程
暗Kcell
Set Book=workbook.Open（文件路径）
Set Krange=Book.Sheets（SheetVar.Range）（“A1:A200”）
'为finder excel工作表声明变量（D列）
暗德兰奇射程
暗电池
设置Drange=ThisWorkbook.Sheets（“Sheet1”）.范围（“D5:D205”）
'为finder excel工作表声明变量（C列）
暗淡的裂缝如射程
暗室
Set Crange=ThisWorkbook.Sheets（“Sheet1”）.范围（“C5:C205”）
'用于复制信息并将其粘贴到Finder中的For循环
对于Krange的每个Kcell
如果Kcell.Value=“IT”，则
书本页（SheetVar）.Range（Kcell.Offset（0,2），Kcell.Offset（0,8））.Copy
对于Drange中的每个Dcell
如果IsEmpty（Dcell.Value）=True且IsEmpty（Dcell.Offset（0，-1.Value）=True，则
此工作簿.Sheets（“Sheet1”）.Range（Dcell.Offset（0,0），Dcell.Offset（0,8））.PasteSpecial
如果Dcell.Offset（0,6）.Value=“确定”，则
范围（Dcell.Offset（0,0），Dcell.Offset（0,6））.Interior.Color=RGB（113221131）
如果结束
如果Dcell.Offset（0,6）.Value“OK”且为空（Dcell.Offset（0,6）.Value）=False，则
范围（Dcell.Offset（0,0），Dcell.Offset（0,6））.Interior.Color=RGB（221100120）
如果结束
退出
如果结束
下一个Dcell
如果结束
如果Kcell.Value=“DA”，则
书本页（SheetVar）.Range（Kcell.Offset（0,1），Kcell.Offset（0,1））.Copy
对于起重机中的每个Ccell
如果IsEmpty（Ccell.Value）=True，并且IsEmpty（Ccell.Offset（0，1.Value）=True，那么
此工作簿.Sheets（“Sheet1”）.Range（Ccell.Offset（0,0），Ccell.Offset（0,0））.PasteSpecial
退出
如果结束
下一个Ccell
如果结束
下一个Kcell
工作簿（文件）。关闭SaveChanges=False
File=Dir
环
范围（“C2:J200”）。水平对齐=xlCenter
'范围（“F5:F200”）。排序键1:=范围（“F5”），顺序1:=xl升序，标题：=xlNo
端接头

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

此代码可以执行以下操作：

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

希望这能帮到其他人

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