欢迎您访问程序员文章站本站旨在为大家提供分享程序员计算机编程知识!
您现在的位置是: 首页

VBA 在指定目录及其子目录中的excel文件中检索指定的文字列

程序员文章站 2024-01-27 15:52:28
...
效果图:
VBA 在指定目录及其子目录中的excel文件中检索指定的文字列
            
    
    博客分类: VBA vba 
对应的代码入下:
对应的代码入下:

Sub getColumn()
    
    Dim work1 As Workbook
    Dim path, keyWord As String
    Dim fileContent As String
    Dim unFoundCol As String
    
    ' 指定检索的目录
    path = ThisWorkbook.Sheets(2).Range("F1").Value
    '指定的检索文字列
    keyWord = ThisWorkbook.Sheets(2).Range("F2").Value
    If IsEmpty(path) Then
        MsgBox ("请输入路径")
        Exit Sub
    End If
     If IsEmpty(keyWord) Then
        MsgBox ("请输入检索路径")
        Exit Sub
    End If
    fileContent = searchKeyWord(path, keyWord)
    
    MsgBox ("检索完成")

End Sub

' 检索函数
Function searchKeyWord(path, keyWord)
    Dim j As Integer
    Dim MyFile, MyPath, MyName
    Dim file() As String
    Dim Wb As Workbook, Ws As Worksheet, FN$
    Dim i, k, x
    j = 6
    i = 1
    k = 1
    x = 1
    
    ReDim file(1 To i)
    file(1) = path & "\"
    Do Until i > k
    FN = Dir(file(i), vbDirectory)     '获取文件夹下的文件

        Do Until FN = ""
            If InStr(FN, ".") = 0 Then '如果是个文件夹,则将该文件夹添加到检索目录里

                k = k + 1

                ReDim Preserve file(1 To k)

                file(k) = file(i) & FN & "\"
            Else
                 If InStr(FN, ".xls") > 0 Then
                    Set Wb = GetObject(file(i) & "\" & FN)    'OPEN File
                    With Wb
                        For Each Ws In .Worksheets  '循环每个sheet检索

                            With Ws
                                If WorksheetFunction.CountIf(.UsedRange, "*" & keyWord & "*") <> 0 Then  '在每个sheet的活动区检索文字列       

                                   ThisWorkbook.Sheets(2).Range("A" & j).Value = file(i)
                                    ThisWorkbook.Sheets(2).Range("B" & j).Value = FN
                                    ThisWorkbook.Sheets(2).Range("C" & j).Value = Ws.Name '检索到输出,可以改成自己想要的格式
                                    j = j + 1
                                    GoTo nextFound
                                 End If
                            End With
                            Next Ws
                      End With
                      Wb.Close False  '关闭excel文件不保存
 
                End If
           End If
nextFound:   FN = Dir  '检索下一个文件
       Loop
    i = i + 1
    Loop
End Function

  • VBA 在指定目录及其子目录中的excel文件中检索指定的文字列
            
    
    博客分类: VBA vba 
  • 大小: 45.9 KB
相关标签: vba