Tạo macro tìm kiếm chuỗi kí tự trong các file excel ở cùng thư mục

Nếu muốn tìm kiếm chuỗi kí tự nào đó trong tất cả các file ở cùng một thư mục , sau đó tạo đường Link để mở tới các vị trí đó , bạn cần phải tạo một macro .

Cách thức như sau

Mở Excel , bấm tổ hợp phím Alt-F11 để mở của sổ Microsoft Visual Basic .

Trong cửa sổ Microsoft Visual Basic , bấm Insert > Module , bạn copy nội dung bên dưới

 

Sub SearchWKBooks()

Dim WS As Worksheet

Dim myfolder As String

Dim Str As String

Dim a As Single

Dim sht As Worksheet

Set WS = Sheets.Add

With Application.FileDialog(msoFileDialogFolderPicker)

   .Show

   myfolder = .SelectedItems(1) & \"\\\"

End With

Str = Application.InputBox(prompt:=\"Search string:\", Title:=\"Search all workbooks in a folder\", Type:=2)

If Str = \"\" Then Exit Sub

WS.Range(\"A1\") = \"Search string:\"

WS.Range(\"B1\") = Str

WS.Range(\"A2\") = \"Path:\"

WS.Range(\"B2\") = myfolder

WS.Range(\"A3\") = \"Workbook\"

WS.Range(\"B3\") = \"Worksheet\"

WS.Range(\"C3\") = \"Cell Address\"

WS.Range(\"D3\") = \"Link\"

a = 0

Value = Dir(myfolder)

Do Until Value = \"\"

   If Value = \".\" Or Value = \"..\" Then

   Else

       If Right(Value, 3) = \"xls\" Or Right(Value, 4) = \"xlsx\" Or Right(Value, 4) = \"xlsm\" Then

           On Error Resume Next

           Workbooks.Open Filename:=myfolder & Value, Password:=\"zzzzzzzzzzzz\"

           If Err.Number > 0 Then

               WS.Range(\"A4\").Offset(a, 0).Value = Value

               WS.Range(\"B4\").Offset(a, 0).Value = \"Password protected\"

               a = a + 1

           Else

               On Error GoTo 0

               For Each sht In ActiveWorkbook.Worksheets

                       Set c = sht.Cells.Find(Str, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)

                       If Not c Is Nothing Then

                           firstAddress = c.Address

                            Do

                               WS.Range(\"A4\").Offset(a, 0).Value = Value

                               WS.Range(\"B4\").Offset(a, 0).Value = sht.Name

                               WS.Range(\"C4\").Offset(a, 0).Value = c.Address

                                WS.Hyperlinks.Add Anchor:=WS.Range(\"D4\").Offset(a, 0), Address:=myfolder & Value, SubAddress:= _

                               sht.Name & \"!\" & c.Address, TextToDisplay:=\"Link\"

                               a = a + 1

                              Set c = sht.Cells.FindNext(c)

                           Loop While Not c Is Nothing And c.Address <> firstAddress

                       End If

               Next sht

           End If

           Workbooks(Value).Close False

         On Error GoTo 0

       End If

   End If

   Value = Dir

Loop

Cells.EntireColumn.AutoFit

End Sub

 

Quay trở lại Excel .

Bấm chọn tab Developer > Macro , chạy macro có tên là SearchWKBooks

 

\"hinh1\"

 

Khi chạy macro này đầu tiên sẽ xuất hiện khung cửa sổ yêu cầu bạn đưa thư mục muốn tìm kiếm

Tiếp theo chuối kí tự bạn muốn tìm kiếm

 

\"hinh2\"

 

Sau khi tìm kiếm bạn sẽ được kết quả như hình bên dưới

 

\"hinh3\"