Xóa name rác

[philip]

Chào cả nhà, hôm trước mình có copy Macro xóa name rác RemoveBadnames về và chạy thử, nhưng nó có lỗi. Ai có thể sửa lại giúp được ko?

Sub RemoveBadNames()

Dim N As Variant
Dim rtn As Variant

For Each N In ActiveWorkbook.Names
If N.refersto Like "*[#]REF*" Then
rtn = MsgBox("BAD NAME: Delete name '" & N.Name & "'
refersto: '" & N.RefersTo, vbQuestion + vbYesNo)
'rtn = vbYes
If rtn = vbYes Then N.Delete
ElseIf N.refersto Like "*:\*" Then
rtn = MsgBox("EXTERNAL LINK: Delete name '" & N.Name & "'
refersto: '" & N.RefersTo, vbQuestion + vbYesNo)
If rtn = vbYes Then N.Delete
End If
Next

End Sub

 

[windowmtd166]

hic hic, em cũng đang rất cần cái này. Trong file của em giờ move qua file khác nó báo một đống name, nhấn yes mệt xỉu, dù là em ko tạo ra các name đó, chắc do copy từ file khác mà nó có, giờ nó nhiều lắm, em muốn xóa sạch mà excel nó chỉ cho mỗi lần xóa 1 name hic hic, chắc xóa tới già lun quá vì hầu như sheet nào cũng dính cả ngàn name huhu

 

[songtrieu]

hic hic, em cũng đang rất cần cái này. Trong file của em giờ move qua file khác nó báo một đống name, nhấn yes mệt xỉu, dù là em ko tạo ra các name đó, chắc do copy từ file khác mà nó có, giờ nó nhiều lắm, em muốn xóa sạch mà excel nó chỉ cho mỗi lần xóa 1 name hic hic, chắc xóa tới già lun quá vì hầu như sheet nào cũng dính cả ngàn name huhu

Có vài chương trình free được down miễn phí trên PCworld.com có thể giải quyết được vấn đề name rác. Tuy nhiên cũng không được good cho lắm. Để giải quyết triệt để, bạn có thể cài đặt OFFICE 2007 và xóa name rác rất đơn giản (chỉ mất từ 3 -5 giây cho hơn 10.000 name)

 

[Lệnh Hồ Đại Hiệp]

Chào cả nhà, hôm trước mình có copy Macro xóa name rác RemoveBadnames về và chạy thử, nhưng nó có lỗi. Ai có thể sửa lại giúp được ko?

Sub RemoveBadNames()

Dim N As Variant
Dim rtn As Variant

For Each N In ActiveWorkbook.Names
If N.refersto Like "*[#]REF*" Then
rtn = MsgBox("BAD NAME: Delete name '" & N.Name & "'
refersto: '" & N.RefersTo, vbQuestion + vbYesNo)
'rtn = vbYes
If rtn = vbYes Then N.Delete
ElseIf N.refersto Like "*:\*" Then
rtn = MsgBox("EXTERNAL LINK: Delete name '" & N.Name & "'
refersto: '" & N.RefersTo, vbQuestion + vbYesNo)
If rtn = vbYes Then N.Delete
End If
Next

End Sub

Tham khảo nhé :

Sub DeleteErrName()
    On Error Resume Next
    Dim NSh As Name, i As Integer
    Dim OldStatus As Boolean, ThongBao As String
    OldStatus = Application.DisplayStatusBar
    Sheets.Add.Name = "ShName"
    For Each NSh In ActiveWorkbook.Names
        If InStr(1, NSh.RefersToR1C1, "#") > 0 Or _
           InStr(1, NSh.RefersToR1C1, "\") > 0 Then
            i = i + 1
            Application.StatusBar = "Deleted : " & Format(i, "#,##0") & _
                "     Deleting...: " & NSh.Name
            Sheets("ShName").Range("A" & i).Value = NSh.Name
            Sheets("ShName").Range("B" & i).Value = " " & NSh.RefersToR1C1
            NSh.Delete
        End If
    Next
    If i > 0 Then _
        ThongBao = ThongBao & Chr(13) & Chr(13) & "   -" & Format(i, "#,##0") & " Names da xoa"
        
    MsgBox ThongBao, vbInformation, "GPE"

    Application.StatusBar = ""
    Application.DisplayStatusBar = OldStatus
End Sub

Chúc vui.

 

[ndtnv]

Hàm trên mà chạy với file bạn gửi có trên 700 name thì bấm MsgBox mỏi tay
Theo tôi thì tách thành 2 hàm, hàm xóa name lỗi không cần hiện MsgBox
Phần xóa EXTERNAL LINK như trên chỉ xóa trên máy local, không xóa trên máy mạng
Đây là 2 hàm tôi đang dùng. Các bạn sửa lại cho phù hợp với từng máy, bổ sung MsgBox nếu cần
Các hàm này nếu gặp name tiếng Việt bị lỗi nên phải xóa bằng thủ công do đó phải thêm dòng
On Error Resume Next

Sub DelErrName()
    Dim na
    On Error Resume Next
    For Each na In ActiveWorkbook.Names
        If InStr(na.RefersTo, "#REF") Or InStr(na.RefersTo, "#N/A") _
        Or InStr(na.RefersTo, "#NAME") Then
            na.Delete
        End If
    Next na
End Sub
Sub DelLinkName()
    Dim na
    On Error Resume Next
    For Each na In ActiveWorkbook.Names
        If InStr(na.RefersTo, ".xls") Then
            na.Delete
        End If
    Next na
End Sub

 

[Lệnh Hồ Đại Hiệp]

Hàm trên mà chạy với file bạn gửi có trên 700 name thì bấm MsgBox mỏi tay
Theo tôi thì tách thành 2 hàm, hàm xóa name lỗi không cần hiện MsgBox

Các hạ hãy thử trước khi phát biểu
Chỉ có 1 Msgbox thôi, lấy đâu ra mà bấm mỏi tay.
Chúc vui.

 

[ndtnv]

Các hạ hãy thử trước khi phát biểu
Chỉ có 1 Msgbox thôi, lấy đâu ra mà bấm mỏi tay.
Chúc vui.

Tôi nói bấm mỏi tay là hàm RemoveBadNames của philip, còn hàm của bạn thì có thể chạy đúng trên máy bạn nhưng đem sang máy khác thì cũng xóa sạch cả name rác và cả EXTERNAL LINK name mà có khi còn đang dùng, khả năng xóa name không rác là rất cao vì chỉ xét trong name có các ký tự "#" và "\"

 

[NH_DK]

Tham khảo nhé :

Sub DeleteErrName()
On Error Resume Next
Dim NSh As Name, i As Integer
Dim OldStatus As Boolean, ThongBao As String
OldStatus = Application.DisplayStatusBar
Sheets.Add.Name = "ShName"
For Each NSh In ActiveWorkbook.Names
If InStr(1, NSh.RefersToR1C1, "#") > 0 Or _
InStr(1, NSh.RefersToR1C1, "\") > 0 Then
i = i + 1
Application.StatusBar = "Deleted : " & Format(i, "#,##0") & _
" Deleting...: " & NSh.Name
Sheets("ShName").Range("A" & i).Value = NSh.Name
Sheets("ShName").Range("B" & i).Value = " " & NSh.RefersToR1C1
NSh.Delete
End If
Next
If i > 0 Then _
ThongBao = ThongBao & Chr(13) & Chr(13) & " -" & Format(i, "#,##0") & " Names da xoa"

MsgBox ThongBao, vbInformation, "GPE"

Application.StatusBar = ""
Application.DisplayStatusBar = OldStatus
End Sub

Chúc vui.

Cám ơn bài cuả Lệnh Hồ Đại Hiệp! Bài này thật hay!