Question

我有这段代码，其中将多个工作簿中的数据合并为一个。需要根据来源将每个工作簿的数据添加到特定范围。为此，我嵌套了一些IF，以文件的部分名称作为条件，并给出了将值发送到所需范围的操作，但是当我运行代码时，它仅打开所有工作簿而不执行任何操作。我已经进行了一些研究，没有发现任何可以帮助我解决问题的东西

Sub Update_Database()

Dim directory As String
Dim fileName As String

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    directory = .SelectedItems(1)
    Err.Clear
End With

fileName = Dir(directory & "\", vbReadOnly)

Dim mwb As Workbook
Set mwb = Workbooks("OEE_Database_Final.xlsm")

Do While fileName <> ""
    On Error GoTo ProcExit
    With Workbooks.Open(fileName:=directory & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
        If (fileName = "NOM*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O9:Z290").Value = mwb.Sheets("Database").Range("O9:Z290")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SZE*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O291:Z537").Value = mwb.Sheets("Database").Range("O291:Z537")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "VEC*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O538:Z600").Value = mwb.Sheets("Database").Range("O538:Z600")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "KAY*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O601:Z809").Value = mwb.Sheets("Database").Range("O601:Z809")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "BBL*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O810:Z952").Value = mwb.Sheets("Database").Range("O810:Z952")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "POG*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O953:Z1037").Value = mwb.Sheets("Database").Range("O953:Z1037")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SC1*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1038:Z1159").Value = mwb.Sheets("Database").Range("O1038:Z1159")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SC2*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1160:Z1200").Value = mwb.Sheets("Database").Range("O1160:Z1200")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SLP*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1201:Z1263").Value = mwb.Sheets("Database").Range("O1201:Z1263")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "UIT*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1264:Z1348").Value = mwb.Sheets("Database").Range("O1264:Z1348")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "ANE*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1349:Z1823").Value = mwb.Sheets("Database").Range("O1349:Z1823")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "HAL*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O1824:Z2077").Value = mwb.Sheets("Database").Range("O1824:Z2077")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "SHX*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2078:Z2242").Value = mwb.Sheets("Database").Range("O2078:Z2242")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "BAY*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2243:Z2415").Value = mwb.Sheets("Database").Range("O2243:Z2415")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "TAM*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2416:Z2522").Value = mwb.Sheets("Database").Range("O2416:Z2522")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "PUC*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2523:Z2607").Value = mwb.Sheets("Database").Range("O2523:Z2607")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "JOF*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2608:Z2648").Value = mwb.Sheets("Database").Range("O2608:Z2648")
            ActiveWorkbook.Close SaveChanges:=False
        ElseIf (fileName = "MAV*.xlsx") Then
            ActiveWorkbook.Sheets("Database").Range("O2649:Z2945").Value = mwb.Sheets("Database").Range("O2649:Z2945")
            ActiveWorkbook.Close SaveChanges:=False
        End If
    End With
    fileName = Dir
Loop

Application.ScreenUpdating = True


ProcExit:
Exit Sub

End Sub

Answer 1

您可以“欺骗”一点以逃避Select Case。

为了将Like与Select一起使用，请使用Select Case True，然后使用Like和通配符*来嵌套场景。

代码

With Workbooks.Open(Filename:=directory & "\" & Filename, UpdateLinks:=False, ReadOnly:=True)
    Select Case True
        Case Filename Like "NOM*.xlsx"

        Case Filename Like "SZE*.xlsx"

        Case Filename Like "VEC*.xlsx"

        Case Filename Like "KAY*.xlsx"

        Case Filename Like "BBL*.xlsx"

        ' put all other scenarios down here....


    End Select

End With

注意：如果您要检查的所有文件都是excel文件，则无需添加.xlsx扩展名，只需使用NOM*，{ {1}}，等等。

Answer 2

给出摘要

With Workbooks.Open(fileName:=directory & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
    If (fileName = "NOM*.xlsx") Then
        ActiveWorkbook.Sheets("Database").Range("O9:Z290").Value = mwb.Sheets("Database").Range("O9:Z290")
        ActiveWorkbook.Close SaveChanges:=False
    End If
End With

您正在打开文件，从 mbw.Sheets("Database") 到写入一些值，然后关闭刚刚修改的文件而不保存。

从您的评论看来，您的意图是做相反的事情：

Dim mwb As Workbook
Set mwb = Workbooks("OEE_Database_Final.xlsm")
Dim Ws As Worksheet
Set Ws = mwb.Sheets("Database")

Do While Filename <> ""
    On Error GoTo ProcExit
    With Workbooks.Open(Filename:=directory & "\" & Filename, UpdateLinks:=False, ReadOnly:=True)
        Select Case True
            Case Filename Like "NOM*.xlsx"
                Ws.Range("O9:Z290").Value = .Sheets("Database").Range("O9:Z290").Value
                .Close SaveChanges:=False
            Case Filename Like "SZE*.xlsx"
                ' Code for this case
            ' Other cases...
            Case Else
                ' Put code here that is executed if none of the previous names has been matched
                ' or remove 'Case Else' if you don't want anything to happen then
        End Select
    End With
    Filename = Dir
Loop

一些注意事项：

我已经实施了Shai Rado's answer的建议，以在Like结构中使用Select Case运算符
我已经为Worksheet这样分配了一个新的Set Ws = mwb.Sheets("Database")变量-如果需求发生变化（这是一项更改，而不是〜20项更改，那么这将缩短行并更易于引用其他工作表））
实际上With块已被利用。当您执行With Workbooks.Open时，VBA为您提供对该工作簿的隐式引用。因此，无需引用ActiveWorkbook。一个简单的.就足够了。它还消除了在适当的时间激活 right 工作簿的脆弱性。（想象一下，如果出于某种原因ActiveWorkbook在您的宏的一半位置发生了变化，这将是不可能的……我会给您的。）

从其他工作簿中获取数据-如果嵌套，则无法实现目标

2 个答案: