Question

所以我有我的excel文件（比如说test.xlsx），我在一个文件夹中有多个excel文件（xlsm），它们具有相同的结构（5列，60行，只有它们中的数据不同），我想只搜索E和F列的每个文件，如果我找到一个特定的值（文本），而不是将该特定单元格中的所有文本复制到我的文件（test.xlsx），如果在该文件中多次找到该值相同的文件，而不是插入我的test.xlsx中同一行的下一个单元格中的单元格值，然后移动到下一个文件，我希望它插入文件名，发现数据，与数据在同一行，在下一个单元格...比搜索移动到下一个文件时，我希望从中提取的数据插入到新行中，依此类推。我必须每个月都这样做，我手动完成，你能帮我吗？谢谢。

Answer 1

首先，如果你的代码在那里，你的 Test.xlsx 应该是 xlsm 。所有其他文件（仅包含数据） - 如果没有代码 - 应该是 xlsx 。

现在 - 在 Test.xlsm 模块中使用上述更改尝试此代码：

Sub openFilesExtractData()

    Dim folderPath As String, path As String, yourText As String
    Dim currWbSh As Worksheet
    Dim i As Long, j As Long, k As Long

    folderPath = ThisWorkbook.path

    path = folderPath & "\*.xlsx"

    Filename = Dir(path)

    j = ThisWorkbook.Worksheets(1).UsedRange.Rows.count + 1
    k = 1

    Do While Filename <> ""

        If Filename <> ThisWorkbook.Name And Filename <> "" Then

            Workbooks.Open folderPath & "\" & Filename

            Set currWbSh = Workbooks(Filename).Worksheets(1)

            yourText = InputBox("What are you searching for?")

            For i = 1 To currWbSh.UsedRange.Rows.count

                Select Case yourText

                    Case currWbSh.Cells(i, 5):

                        ThisWorkbook.Worksheets(1).Cells(j, k) = yourText
                        k = k + 1

                    Case currWbSh.Cells(i, 6):

                        ThisWorkbook.Worksheets(1).Cells(j, k) = yourText
                        k = k + 1

                End Select

                If i = currWbSh.UsedRange.Rows.count And k <> 1 Then

                    ThisWorkbook.Worksheets(1).Cells(j, k) = Filename
                    j = j + 1

                End If

            Next i

            Workbooks(Filename).Close False

        End If

        Filename = Dir()
        k = 1
        j = ThisWorkbook.Worksheets(1).UsedRange.Rows.count + 1

    Loop

End Sub

这将打开指定路径中的每个文件，文件结尾为 xlsx ，搜索输入文字 yourText 并在 A1 。如果再次找到相同的值，则将其写入下一列（同一行），依此类推;之后，打开文件的名称将放在同一行的下一列中。

从条件中搜索多个excel文件中的数据并从中提取数据

1 个答案: