Question

我在调试代码时遇到问题。我有一个带有自动过滤器列条件的数组。我的代码应该遍历整个数组，打开一组文件，然后将粘贴信息复制到我的工作簿中。

当我运行代码时，它不会自动执行所需的条件并显示运行时错误1004。我已经尝试搜索解决方案或类似问题，但未发现任何问题。我还尝试记录宏来更改方法，但是在尝试实现循环时，它不起作用：（

有任何帮助！

Sub Update_Database()

Dim directory As String
Dim fileName As String
Dim my_array() As String
Dim iLoop As Integer

ReDim my_array(18)
my_array(0) = "Aneng"
my_array(1) = "Bayswater"
my_array(2) = "Bad Blankenburg"
my_array(3) = "Halstead"
my_array(4) = "Jorf Lasfar"
my_array(5) = "Kolkatta"
my_array(6) = "Marysville"
my_array(7) = "Northeim"
my_array(8) = "Ponta Grossa"
my_array(9) = "Puchov"
my_array(10) = "Renca"
my_array(11) = "Padre Hurtado"
my_array(12) = "Shanxi"
my_array(13) = "San Luis Potosi"
my_array(14) = "Szeged"
my_array(15) = "Tampere"
my_array(16) = "Uitenhage"
my_array(17) = "Veliki Crljeni"

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 <> ""
    For iLoop = LBound(my_array) To UBound(my_array)
        On erro GoTo ProcExit
        With Workbooks.Open(fileName:=directory & "\" & fileName, UpdateLinks:=False, ReadOnly:=True)
            Selection.AutoFilter Field:=1, Criterial:=my_array(iLoop)
            mwb.Worksheets(8).Range("O9:Z2945") = .Worksheets(8).Range("O9:Z2945").Value2
            .Close SaveChanges:=False
        End With
        fileName = Dir
    Next iLoop
Loop

ActiveSheet.ShowAllData

ProcExit:
Exit Sub

End Sub

使用数组自动过滤循环

0 个答案: