0

背景
首先,我意识到所有这些对于数据库来说都是一项完美的任务,但我目前没有可用的选项,我认为继续在 excel 中执行此操作是一种很好的学习体验。

我有多个工作簿,每个工作簿都包含一个标识号列表,通过下面的代码输入我需要的工作簿的名称,然后将该列表导入到包含多列数据的工作簿的主工作簿中。然后我运行我的Match 和 Export 子程序将主要数据集分解为不同的工作表。

问题
有没有办法为包含文件夹中的每个文件使用 for 循环,这样我就不必依次识别每个工作簿?

Sub Export_Specified_Contractor()

    Dim listwb As Workbook, mainwb As Workbook
    Dim fname As String
    Dim sht As Worksheet, oput As Worksheet
    Dim LRow As Long, oLRow As Long
    Dim cprng As Range, orng As Range

    '--> Get the name of the contractor list to be exported
    fname = Application.InputBox("Enter Contractor Name", "Name?")

    Set mainwb = ThisWorkbook

    With Application

    '--> Set contractor list file
    Set listwb = .Workbooks.Open _
    ("C:\Documents and Settings\alistairw\My Documents\Disallowed Items\Contractor Lists\" & fname)
    End With

    Set sht = listwb.Sheets("Sheet1")

    '--> Copy contractor list
    With sht
        LRow = .Range("A" & Rows.Count).End(xlUp).Row
        .Range("A1:A" & LRow).Copy
    End With

    mainwb.Activate

    '--> Create contractor list sheet in main workbook and paste values
    With mainwb
        On Error Resume Next
        Sheets("Sheet2").Delete
        Sheets.Add.Name = "Sheet2"
        Set oput = Sheets("Sheet2")
        With oput
            .Range("A1").PasteSpecial
        End With
    End With

    Call Match_and_Export

    '--> Delete the list workbook and list sheet
    Application.DisplayAlerts = False
    listwb.Close
    oput.Delete
    Application.DisplayAlerts = True
End Sub
4

1 回答 1

2

循环浏览文件夹:

MyPath = "C:\Documents and Settings\alistairw\My Documents\Disallowed Items\Contractor Lists\"
strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 'change to xls if needed

If Len(strFilename) = 0 Then Exit Sub ' exit if no files in folder

Do Until strFilename = ""
    'Your code here
    strFilename = Dir()    
Loop
于 2012-06-06T16:01:28.243 回答