Xin code tìm link trong file

[Hồn Quê]

Thân gởi: Quý anh/em diễn đàn
Em có 1 vướng mắc rất mong mọi người giúp đỡ. File excel của em không biết link từ file khác ở chổ nào mà cứ mỗi lần mở ra là rất chậm và dưới thanh task bar xuất hiện dòng chữ linking đến file khác, em cũng làm theo hướng dẫn là vào Data/Edit link/Break link tuy nhiên tình hình vẫn không cải thiện. Em rất mong mọi người cho em đoạn code để tìm ra link đó nằm ở đâu, em xin cảm ơn ạ.

 

[Maika8008]

Thân gởi: Quý anh/em diễn đàn
Em có 1 vướng mắc rất mong mọi người giúp đỡ. File excel của em không biết link từ file khác ở chổ nào mà cứ mỗi lần mở ra là rất chậm và dưới thanh task bar xuất hiện dòng chữ linking đến file khác, em cũng làm theo hướng dẫn là vào Data/Edit link/Break link tuy nhiên tình hình vẫn không cải thiện. Em rất mong mọi người cho em đoạn code để tìm ra link đó nằm ở đâu, em xin cảm ơn ạ.

Bạn thử chạy sub này để tìm cell có công thức chứa link đến file khác với ký tự tìm là dấu \. (LƯU Ý: Chèn 1 sheet mới và thay Sheet12 bằng định danh của nó). Nếu chưa được thì tìm cách khác.

Sub Link_In_Formula()

Dim Sh As Worksheet
Dim Rg As Range
Dim UsedRg As Range
Dim Val As String, i As Long

For Each Sh In ActiveWorkbook.Worksheets
    Sh.Visible = xlSheetVisible
    Set UsedRg = Sh.UsedRange
    For Each Rg In UsedRg
        On Error Resume Next
        Val = Rg.Find(What:="\", LookIn:=xlFormulas).Address
        If Val <> "" And Rg.HasFormula Then
            i = i + 1
            Sheet12.Range("A" & i) = "Sheet: " & Sh.Name & "-" & Val
        End If
        Val = ""
    Next
Next


End Sub

 

[Hồn Quê]

Bạn thử chạy sub này để tìm cell có công thức chứa link đến file khác với ký tự tìm là dấu \. (LƯU Ý: Chèn 1 sheet mới và thay Sheet12 bằng định danh của nó). Nếu chưa được thì tìm cách khác.

Sub Link_In_Formula()

Dim Sh As Worksheet
Dim Rg As Range
Dim UsedRg As Range
Dim Val As String, i As Long

For Each Sh In ActiveWorkbook.Worksheets
    Sh.Visible = xlSheetVisible
    Set UsedRg = Sh.UsedRange
    For Each Rg In UsedRg
        On Error Resume Next
        Val = Rg.Find(What:="\", LookIn:=xlFormulas).Address
        If Val <> "" And Rg.HasFormula Then
            i = i + 1
            Sheet12.Range("A" & i) = "Sheet: " & Sh.Name & "-" & Val
        End If
        Val = ""
    Next
Next


End Sub

Hic mình add đoạn code này vào rồi nhưng không thấy gì hết bạn à.

 

[Quang_Hải]

Thân gởi: Quý anh/em diễn đàn
Em có 1 vướng mắc rất mong mọi người giúp đỡ. File excel của em không biết link từ file khác ở chổ nào mà cứ mỗi lần mở ra là rất chậm và dưới thanh task bar xuất hiện dòng chữ linking đến file khác, em cũng làm theo hướng dẫn là vào Data/Edit link/Break link tuy nhiên tình hình vẫn không cải thiện. Em rất mong mọi người cho em đoạn code để tìm ra link đó nằm ở đâu, em xin cảm ơn ạ.

Thử đoạn code này. Chú ý là tại ô A1 bắt buộc phải có dữ liệu thì thông báo mới chính xác. Khi tìm được 1 link nào đó, sẽ xuất hiện thông báo và dừng việc chạy code. Sau khi xử lý link đó rồi thì chạy code lại nhé

Sub Find_Links()
Dim sArr(), sh As Worksheet, i As Long, j As Long
For Each sh In ThisWorkbook.Worksheets
   sArr = sh.UsedRange.Formula
   For i = 1 To UBound(sArr)
      For j = 1 To UBound(sArr, 2)
         If sArr(i, j) Like "*:\*" Then
            MsgBox "Sheet: " & sh.Name & ChrW(10) & ChrW(10) _
            & "Cell: " & Cells(i, j).Address & ChrW(10) & ChrW(10) _
            & "Link:" & sArr(i, j)
            Application.Goto sh.Cells(i, j), True
            Exit Sub
         End If
      Next
   Next
Next
End Sub

 

[Hồn Quê]

Thử đoạn code này. Chú ý là tại ô A1 bắt buộc phải có dữ liệu thì thông báo mới chính xác. Khi tìm được 1 link nào đó, sẽ xuất hiện thông báo và dừng việc chạy code. Sau khi xử lý link đó rồi thì chạy code lại nhé

Sub Find_Links()
Dim sArr(), sh As Worksheet, i As Long, j As Long
For Each sh In ThisWorkbook.Worksheets
   sArr = sh.UsedRange.Formula
   For i = 1 To UBound(sArr)
      For j = 1 To UBound(sArr, 2)
         If sArr(i, j) Like "*:\*" Then
            MsgBox "Sheet: " & sh.Name & ChrW(10) & ChrW(10) _
            & "Cell: " & Cells(i, j).Address & ChrW(10) & ChrW(10) _
            & "Link:" & sArr(i, j)
            Application.Goto sh.Cells(i, j), True
            Exit Sub
         End If
      Next
   Next
Next
End Sub

Nó báo type mismatch bác ạ

 

[befaint]

Chời ơi. Linh chi mà có trong công thức thì chủ thớt "bẻ" nát ngay từ bài #1 rồi.

Link có trong từng này chỗ:
- Công thức
- Name
- Data Validation
- Query
- Conditional Formatting

------
@ Thớt: Gửi file lên nhá. Mấy cái này dùng tay và mắt xong việc đi ngủ mấy giấc rồi, chớ xương cốt còn ninh hầm chán chê vẫn chưa gặm được đâu.

haha

 

[Quang_Hải]

Nó báo type mismatch bác ạ

Nếu file không quá nặng thì gởi lên xem thử coi lỗi ở đâu. Trên máy mình thì không thấy báo lỗi

 

[Hồn Quê]

Nếu file không quá nặng thì gởi lên xem thử coi lỗi ở đâu. Trên máy mình thì không thấy báo lỗi

Dạ đây anh, giả định là link đang nằm ở ô E7 làm thế nào để nó hiển thị vậy anh?

 

[Quang_Hải]

Dạ đây anh, giả định là link đang nằm ở ô E7 làm thế nào để nó hiển thị vậy anh?

Thử lại coi sao nhé

Dạ đây anh, giả định là link đang nằm ở ô E7 làm thế nào để nó hiển thị vậy anh? Thử vầy coi sao nhé. Nguyên nhân là có sheet bị rỗng hoàn toàn Sub Find_Links() Dim sArr(), sh As Worksheet, i As Long, j As Long For Each sh In ThisWorkbook.Worksheets If sh.UsedRange.Count > 1 Then sArr = sh.UsedRange.Formula For i = 1 To UBound(sArr) For j = 1 To UBound(sArr, 2) If sArr(i, j) Like "*:\*" Then MsgBox "Sheet: " & sh.Name & ChrW(10) & ChrW(10) _ & "Cell: " & Cells(i, j).Address & ChrW(10) & ChrW(10) _ & "Link:" & sArr(i, j) Application.Goto sh.Cells(i, j), True Exit Sub End If Next Next End If Next End Sub

 

[Hồn Quê]

Thử lại coi sao nhé

Thử vầy coi sao nhé. Nguyên nhân là có sheet bị rỗng hoàn toàn Sub Find_Links() Dim sArr(), sh As Worksheet, i As Long, j As Long For Each sh In ThisWorkbook.Worksheets If sh.UsedRange.Count > 1 Then sArr = sh.UsedRange.Formula For i = 1 To UBound(sArr) For j = 1 To UBound(sArr, 2) If sArr(i, j) Like "*:\*" Then MsgBox "Sheet: " & sh.Name & ChrW(10) & ChrW(10) _ & "Cell: " & Cells(i, j).Address & ChrW(10) & ChrW(10) _ & "Link:" & sArr(i, j) Application.Goto sh.Cells(i, j), True Exit Sub End If Next Next End If Next End Sub

Dạ đúng y rồi anh, nay anh lên sếp rồi mà còn thời gian tham gia diễn đàn và viết bài? Thật ngưỡng mộ anh !!!!

 

[huuthang_bd]

Dạ đây anh, giả định là link đang nằm ở ô E7 làm thế nào để nó hiển thị vậy anh?

Sao cứ phải lòng vòng thế nhỉ, link thế thì Break Link là đứt rồi. Tưởng bạn cần cái khác chứ?

 

[Hồn Quê]

Sao cứ phải lòng vòng thế nhỉ, link thế thì Break Link là đứt rồi. Tưởng bạn cần cái khác chứ?

Không phải đâu bác nếu em tìm ra được link thì nói chi nữa đằng này mở ra thấy nó đang linking đến file khác nhưng không biết link đó nó nằm ở đâu nên mới nhờ anh em giúp đó ạ

 

[huuthang_bd]

em cũng làm theo hướng dẫn là vào Data/Edit link/Break link tuy nhiên tình hình vẫn không cải thiện

Cái này là chính bạn nói nhá.
Giờ thử tải file bài #8 rồi làm vậy xem thế nào.