Question

此时为了简单起见，我只创建了3个excel文件：Book1，Book2，Book3，每个文件有2列。我遍历所有excel文件并填充我的数组中的所有变量，但我无法在我的搜索Excel文件中显示我需要的值。一列是 MyValue ，另一列是值，我需要在我的搜索Excel文件中显示（带有我的宏的文件）。 MyValue 可以有多个具有相同值的行，我应该采用所有值（这些不一样））并显示它们。

Sub MyFunction()

Dim MyValue As String
Dim MyFolder As String 'Path containing the files for looping
Dim MyFile As String 'Filename obtained by Dir function

Dim Matrice() As Variant
Dim Dim1, Dim2 As Long

MyFolder = "E:\Excel Files\" 'Assign directory to MyFolder variable

MyFile = Dir(MyFolder) 'Dir gets the first file of the folder

Application.ScreenUpdating = False
MyValue = InputBox("Type the Value")

'Loop through all files until Dir cannot find anymore
Do While MyFile <> ""
    Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)
    'Sheets1.Activate
    Dim1 = Range("A2", Range("A1").End(xlDown)).Cells.Count - 1
    Dim2 = Range("A1", Range("A1").End(xlToRight)).Cells.Count - 1

    ReDim Matrice(0 To Dim1, 0 To Dim2)
    'The statements you want to run on each file
    For Dim1 = LBound(Matrice, 1) To UBound(Matrice, 1)
        For Dim2 = LBound(Matrice, 2) To UBound(Matrice, 2)

        Matrice(Dim1, Dim2) = Range("A2").Offset(Dim1, Dim2).Value
        If Matrice(Dim1, Dim2) = MyValue Then
            ThisWorkbook.Activate
            Range("A1", Range("A2").End(xlDown)) = Matrice(Dim1, Dim2 + 1)
            ' Values that i want to be displayed on column A in my Search.xlsm file
            ' is not displayed any value

        End If

        Next Dim2
    Next Dim1

    wbk.Close savechanges:=True
    MyFile = Dir 'Dir gets the next file in the folder

Loop

End Sub

Answer 1

希望我理解你的帖子，下面的代码只复制 Value 数据，其中Cells值（在 B列中）= < em> MyValue 进入 Matrice（）数组。

修改1 ：删除该部分，删除所有值重复项。

将所有值复制到 ThisWorkbook（“Sheet1”）。

data$option1 <- ifelse(column1=='option1' || column2=='option1' || column3=='option1',1,0)

Answer 2

我使用了Filter和RemoveDuplicates的组合。

Sub ImportUniqueData()
    Const MyFolder = "E:\Excel Files\"
    Dim xlWB As Workbook
    Dim NextRow As Long
    Dim MyFile As String, MyValue As String
    Dim FilteredData As Range
    MyFile = Dir(MyFolder & "*.xlsx")
    MyValue = InputBox("Type the Value")

    Do Until MyFile = ""
        NextRow = Range("A" & Rows.Count).End(xlUp).Row + 1

        Set xlWB = Workbooks.Open(Filename:=MyFolder & MyFile)

        With xlWB.Worksheets(1)
            .Rows(1).AutoFilter Field:=1, Criteria1:=MyValue
            Set FilteredData = .Range("A1").CurrentRegion.Offset(1).SpecialCells(xlCellTypeVisible)
            FilteredData.Copy ThisWorkbook.ActiveSheet.Cells(NextRow, 1)
        End With

        xlWB.Close SaveChanges:=False

        MyFile = Dir
    Loop

    ActiveSheet.UsedRange.RemoveDuplicates
End Sub

循环遍历多个excel文件并返回值

2 个答案: