Excel VBA 消せない入力規則外部リンクエラーの削除ツール

どうしても消せない Excel の外部リンクエラー! そのほとんどが「入力規則」をセル範囲のリストで設定していたものがリンク切れとなったケースです。
今回は、その部分だけに絞ってリンク切れエラーの「定義」部分をVBAで強制削除するツールを自分用に作成してみたので紹介したいと思います。

くるみこ
くるみこ

今回は、あくまで自分用に設定してみたものの紹介です!

もし、試してみようと思われた方は、自己責任で行ってくださいね!
必ず事前にバックアップを取ってから試してください!

初めに、この記事で紹介している方法でブレイクリンクをしてみてください。

それでも消えないリンクが残った場合は、次の記事が参考になります。
ただし、すべて手動で行う必要があります。今回の記事はこの部分をVBAで処理します。

次の記事では、手動でエラーリンクを探すかわりにVBAでファイルのエラー数を見るツールです。

XMLファイル内のエラー部分を強制削除してくれるツールということですね。
ファイル内の文字列を操作する方法としてすごく勉強になりそうですね。

よろしくお願いしますm(__)m

【この記事でわかることは】
エラーのあるXMLファイル(UTF-8)から該当部分を削除する方法がわかります
「InStr」「InStrRev」「Val」「Mid」「Replace」関数を駆使して削除します

まず動作設定を検討しました

Excel の外部リンクエラーをブレークリンクしてみたけど、どうしても消えない部分がある!
そんな場合の消えない部分は、データの「入力規則」でリストをセル範囲に設定していたものがほとんどです。シートのコピペなどで、セル範囲が外部リンクになったことでリンク切れが発生しているケースです。下の画像がその状態が発生している部分です。

エラー部分を探すコードを前回の記事で紹介しています。今回はそのコードに手を加えます。

初めに、どんな動作をさせたいのか基本的な手順を次のように決めていきました。

  1. 【前提】ブレイクリンクで解除可能なエラーリンクを削除しておきます。
    これでも外部リンクが消せない場合に次の手順に移ります。
  2. 対象のExcelファイルをバックアップしていおきます。コピーを別の場所に保存するかファイル名を変更して保存します(保存場所は任意)(事故防止のため必ずバックアップしてくださいね)
  3. ファイルの拡張子を変更します。(.xls? → .zip)
  4. zip を任意の場所に解凍します。
  5. 前回記事で紹介したエラーを探すツールでエラーがあるワークシートを探します。
    この部分は、今回</x14:dataValidations>専用に調整しています。
  6. 外部リンクエラーを解除したいワークシートのXMLファイルをセルで選択します。
  7. [外部リンクエラー強制削除] ボタンを押してマクロを開始します。
    ≪ここからVBAで削除する処理≫
  8. 選択セルから「xmlファイル」のフルパスを取得します。
  9. 取得したフルパスを [削除用プロシージャ] に渡します。
  10. 「xmlファイル」(UTF-8)をADODB.Streamでテキストとして読み込みます
  11. Stream から変数にデータを代入します
  12. <x14:dataValidations count = “※” ※ = 定義数 を取得します。
  13. 変数内のエラー箇所「!#REF!」を Instr関数 で検索し位置を取得します。
  14. 同じく「入力規則」定義設定範囲を Instr関数 で位置を取得します。
    範囲の先頭は “<x14:dataValidations“  (s が付く)
    範囲の最後は “</x14:dataValidations>” (s が付く)
    一定義の先頭は “<x14:dataValidation” (s 無し)
    一定義の最後は “</x14:dataValidation>” (s 無し)
  15. これらの取得できた位置データから「!#REF!」のある定義を削除します。
    削除には Replace関数 を使いますが、ワイルドカードは使えないので定義全体の文字列を Mid関数 で取得してから ”” 空白に置き換えて削除します。
  16. !#REF!」のある定義をすべて削除後に、削除した件数を最初に取得しておいた定義数から減算する処理をして Replace関数 で書き換えます。
  17. 書換完了後の変数を ADODB.Stream で 元の xmlファイルに上書き保存します。
  18. 削除完了メッセージを出して終了です。
  19. 再びZIPファイル化して、拡張子をエクセルに戻して開いて確認します。

ワークシートXMLの「!#REF!」エラーを強制削除

Excel の zip解凍後のファイル(xmlファイル)内のエラー箇所数をチェックする処理です。

Excelの外部リンクをVBAで一括解除する【実務で活用できる】のファイルに機能を追加及び変更を加えていくこととします。

ワークシートを用意(変更)します

C列、D列、E列の見出しの文字列を変更しています。K、L列に削除した定義データを表示しますのでその見出しを設定しています

・実行用のボタンをシェイプで二つ設置しています。追加したのは「削除実行」用のボタンです。

画像は、B4の「sheet3.xml」のエラー削除を実行した結果を表示しています。

VBAコードを設定します

紹介するVBAは前回記事を改変した「チェック用のコード」と「削除実行のコード」及び「削除対象ファイルの選択コード」の三つです。

このほかに前回記事で紹介している次のコードはここでは解説を省略しています。

チェック用のコード(前回記事で使用したものを改変しています)

コード内にコメントをつけていますので細かい詳細については省略します。

'データ内の<X14:DataValidation>の「#REF!」エラー数を調べる
Sub DataValidationSearch(sFilePath As String)
    Dim tgf As String
    Dim sAll As String
    Dim filenum As Long
    Dim col As Long
    Dim t As Long
    Dim n As Long
    Dim DVcount As Long
    
On Error GoTo ErrorHandler
    tgf = sFilePath
    'UTF-8対応のためADO(ActiveX Data Objects)を使う
    Const ReadBytes = 131072 '分割サイズ指定
    
    Dim sText As String
    With CreateObject("ADODB.Stream")
        '(規定値)Type = adTypeText
        '(規定値)Mode = adModeRead
        .Charset = "UTF-8"
        .Open               'Streamオブジェクトを開く
        .LoadFromFile tgf   'ファイルをStreamに読込
        .Position = 0

        Do While Not .EOS
            '指定文字数を読み込んで書き込む
            sAll = sAll & .ReadText(ReadBytes)
            DoEvents
        Loop
        .Close              'Streamを閉じる
    End With
    Dim t2 As Long
    Dim tn As Long
    '2列分調べるためのループ処理
    For col = 3 To 4
        If col = 3 Then
            'データ内の文字列を調査(初回)tは検索HIT位置
            t = InStr(sAll, "<x14:dataValidations count=")
            sText = Mid(sAll, t + 28, 5)
            DVcount = Val(sText) '文字列内の数値取得
            '調べた結果をセルに書き込む
            Cells(cnt, col) = DVcount '定義数を書き込む(C列)
            '定義の終了位置取得
            tn = InStrRev(sAll, "</x14:dataValidations>")
        Else
            '個別定義の開始位置取得
            t = InStr(sAll, "<x14:dataValidation ")
            '取得出来たらカウントする
            If t > 0 Then n = n + 1
            '初回HIT以降を繰り返し調べる
            Do While t > 0
                t = InStr(t + 1, sAll, "<x14:dataValidation ")
                If t > 0 Then n = n + 1
            Loop
            '調べた結果をセルに書き込む(D列)
            Cells(cnt, col) = n
            n = 0   '変数 n 再利用のため初期化
            '次に"!#REF!"の数を調べる
            t2 = InStr(sAll, "!#REF!") 't2 は検索HIT位置
            '定義内にあるエラーならカウントする
            If t2 > 0 And t2 < tn Then n = n + 1
            '初回HIT以降を繰り返し調べる
            Do While t2 > 0
                t2 = InStr(t2 + 1, sAll, "!#REF!")
                '定義内にあるエラーならカウントする
                If t2 > 0 And t2 < tn Then n = n + 1
            Loop
            '調べた結果をセルに書き込む(E列)
            Cells(cnt, col + 1) = n
        End If
    Next col
    Exit Sub
ErrorHandler:
    If Err.Number = -2147024809 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
        "[" & tgf & "]" & vbCrLf & _
        "はバイナリファイルのために発生したと思われます。" & vbCrLf & _
        "このまま処理を継続します!", _
        vbOKOnly + vbCritical, "ADODB.Stream Error"
        Resume 0
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
        "[" & tgf & "]" & vbCrLf & _
        "の処理中に発生したエラーです!" & vbCrLf & _
        "処理を中止します!", _
        vbOKOnly + vbCritical, "ADODB.Stream Error"
        End
    End If
End Sub

・前回のコードを <x14:dataValidations> 定義部分だけに絞って検索するように変更しています。

・定義に「count =”数字”」で表示されている「数字」の取得と、検索して取得した件数、さらに !#REF!エラーの件数をワークシートに書き出すコードです。

削除スタートはファイルを選択するコード

ワークシートに配置した「選択ファイルのエラーを強制削除」ボタン押下で実行されるコードです。

'削除はここからスタート(セル選択指定)
Sub FilePathSet()
    Dim myPath As String
    Dim tgRow As Long
    Dim tgFilePath As String
    Dim res As Long
    Dim lrow As Long

    'アクティブセルの位置(行)取得
    tgRow = ActiveCell.Row
    'フルパスのファイル名取得
    tgFilePath = Cells(tgRow, 1) & "\" & Cells(tgRow, 2)
    If Dir(tgFilePath) = "" Then
        res = MsgBox("ファイルを指定しますか?", vbOKCancel)
        If res = vbOK Then
            myPath = ThisWorkbook.Path
            With Application.FileDialog(msoFileDialogFilePicker)
                .Title = "対象ファイル選択"
                .InitialFileName = myPath
                If .Show = True Then
                    tgFilePath = .SelectedItems(1)
                Else
                    Exit Sub
                End If
            End With
        Else: Exit Sub
        End If
    End If
    '見出しを除きシートの書き出し範囲をクリアする
    lrow = Cells(Rows.count, 12).End(xlUp).Row
    If lrow > 1 Then Range(Cells(2, 11), Cells(lrow, 12)).ClearContents
    '削除処理呼び出し
    Call ReplaceStrFile(tgFilePath)
End Sub

・12行目で、選択セルからフルパスを取得して変数 tgFilePath に入れています。

・13~28行目は、 選択セルにデータがなかった場合、ファイル選択ダイアログで選択できるようにしています。

・30~31行目は、ワークシートの結果書き出し範囲をクリアしています。

・33行目で、削除処理のプロシージャに対象ファイルのフルパスを渡して呼び出しています。

XMLファイル内の外部リンク切れエラーを削除するコード

ADO(ActiveX Data Objects) の ADODB.Stream(UTF-8 形式)のテキスト内データを改変処理するコードがこちらです。 コード内にコメントをつけていますので細かい詳細は省略します。

'データ内文字列の置換処理
Sub ReplaceStrFile(sFilePath As String)
    Dim tgf As String
    Dim sAll As String
    Dim sAllr As String
    Dim s As Long, t As Long, n As Long
    Dim con As Long
    Dim DVcount As Long
    Dim tREF As Long
    Dim ts As Long, tn As Long
    Dim RepStr As String
    Dim rText As String, sText As String
    
On Error GoTo ErrorHandler
    tgf = sFilePath
    'UTF-8対応のためADO(ActiveX Data Objects)を使う
    Const ReadBytes = 131072
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open               'Streamオブジェクトを開く
        .LoadFromFile tgf   'ファイルをStreamに読込
        .Position = 0
        Do While Not .EOS
            '指定文字数分を読み込んで書き込む
            sAll = sAll & .ReadText(ReadBytes)
            DoEvents
        Loop
        .Close              'Streamを閉じる
    End With
    
    '<x14:dataValidations count= を調べて定義数を確認保存する
    s = InStr(sAll, "<x14:dataValidations") 'sは検索HIT位置
    n = InStrRev(sAll, "</x14:dataValidations>") '最終範囲
    If s > 0 And n > 0 Then
        t = InStr(s + 1, sAll, "count=") '次の位置取得
        sText = Mid(sAll, t + 7, 10) 'count=の後ろの5文字取得
        DVcount = Val(sText) '取得文字列からVal関数で数値取得
    Else
        '見つからない場合抜ける
        MsgBox "<x14:dataValidations>入力規則の定義が見つかりません!"
        Exit Sub
    End If
    '"!#REF!"の位置を調べる
    tREF = InStr(t, sAll, "!#REF!") 'tより後ろの位置検索
    If tREF = 0 Then MsgBox "!#REF!はありませんでした!": Exit Sub
    'エラーの<x14:dataValidation>定義範囲先頭位置取得
    ts = InStrRev(sAll, "<x14:dataValidation ", tREF)
    If ts = 0 Then MsgBox "定義範囲が不明です!": Exit Sub
    'エラーが定義範囲内ならその定義を削除する処理
    If t < ts And ts < tREF Then
        '定義範囲の最終位置を特定する
        tn = InStr(tREF, sAll, "</x14:dataValidation>") + 20 '+20文字
        If tn = 0 Then MsgBox "定義範囲が不明です!": Exit Sub
        If tREF < tn Then con = con + 1   '削除対象件数をカウント
        '定義の文字列を変数に保存
        RepStr = Mid(sAll, ts, tn - ts + 1)
        '定義文字列をReplaceで削除して保存用の別テキストに書き込む
        sAllr = Replace(sAll, RepStr, "")
        '削除した定義をセルに書き込む(E列)
        Cells(con + 1, 11) = con
        Cells(con + 1, 12) = RepStr
        '二つ目以降の"!#REF!"を繰り返し調べる
        Do While tREF > 0
            tREF = InStr(sAllr, "!#REF!") 'HIT位置取得
            If tREF > 0 And tREF < tn Then
                con = con + 1   '削除対象件数を追加カウント
                'エラー範囲の先頭位置と終了位置を取得
                ts = InStrRev(sAllr, "<x14:dataValidation ", tREF)
                tn = InStr(tREF, sAllr, "</x14:dataValidation>") + 20
                '定義範囲の文字列を変数に保存
                RepStr = Mid(sAllr, ts, tn - ts + 1)
                '定義文字列をReplaceで削除して上書き
                sAllr = Replace(sAllr, RepStr, "")
                '削除した定義をセルに書き込む(E列)
                Cells(con + 1, 11) = con
                Cells(con + 1, 12) = RepStr
            End If
        Loop
    End If
    '定義カウント値を変更する処理
    If con >= DVcount Then
        '定義数と同数以上だった場合は定義全体を元のテキストから削除する
        rText = Mid(sAll, s, n + 21) '21文字分下げる
        sAllr = Replace(sAll, rText, "")
    Else
        '定義数を DVcount から con マイナスに書き換える
        rText = Replace(sText, DVcount, DVcount - con)
        sAllr = Replace(sAllr, sText, rText)
    End If
    '"!#REF!"fix後のデータをADODB.Streamでファイルに上書きする処理
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open               'Streamオブジェクトを開く
        .WriteText sAllr    'Streamに書き込む
        .SaveToFile (tgf), 2 'Streamをファイルに上書き保存(2)
        .Close              'Streamを閉じる
    End With
    MsgBox "「入力規則」エラー!#REF!の削除が完了しました!"
    Exit Sub
    
ErrorHandler:
    If Err.Number = -2147024809 Then
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
        "[" & tgf & "]" & vbCrLf & _
        "はバイナリファイルのために発生したと思われます。" & vbCrLf & _
        "このまま処理を継続します!", _
        vbOKOnly + vbCritical, "ADODB.Stream Error"
        Resume 0
    Else
        MsgBox "Error " & Err.Number & ": " & Err.Description & vbCrLf & _
        "[" & tgf & "]" & vbCrLf & _
        "の処理中に発生したエラーです!" & vbCrLf & _
        "処理を中止します!", _
        vbOKOnly + vbCritical, "ADODB.Stream Error"
        End
    End If
End Sub

・80~89行目、ここで定義数を削除後の定義数値に書き換える処理を行っています。
 定義数と削除数を比較して削除数が同数以上だった場合は、定義範囲全体を削除します。

・91~97行目で、エラーのあった定義の削除を完了したデータを ADODB.Stream を使ってXMLファイルに上書きする処理を行っています。

コード内で使用した関数について

コード内で使用している関数は「InStr」「InStrRev」「Val」「Mid」「Replace」です。
※各関数の詳細は Microsoftリファレンスのリンクを設定したのでそちらを参照してください。

InStr 関数 は、文字列内を検索し対象文字列が見つかった最初の位置を返す関数です。

InStrRev 関数 は、InStr が前から検索するのに対して文字列の最後から検索する関数です。

Val 関数 は、文字列を数値に変換する関数です。

Mid 関数 は、文字列の指定した位置から文字数分の文字列を返する関数です。

Replace 関数 は、文字列を検索して指定文字に置換する関数です。

エラー定義範囲削除に使用した方法

Replace 関数で 文字列を “”(空白)に置き換えることで削除しています。

ただし、Replace 関数ではワイルドカードは使えません。そこで、次の手法を使いました。

まず、削除対象文字列の最初や最後の位置を Instr 関数InstrRev 関数 で取得します。

次に、Mid 関数 で変数に「削除対象範囲の文字列」全体を代入します。

最後に、Replace 関数で文字列全体から「変数の文字列」を “”(空白)に置換して削除しました。

 

★ これで、ワークシートXML内のエラー定義をVBAで削除できるようになりました。

スポンサーリンク

まとめ(おわりに)

以上、Excelのどうしても消せない「入力規則」x14:dataValidation の外部リンクエラーを強制削除するVBAの解説でした。

サンプルファイルをダウンロードできるように登録していますので是非ご利用ください。
ただし、使用にあたっては自己責任でお願します。

まとめと感想など

くるみこ
くるみこ

今回は、外部リンクエラーのあるワークシートXmlファイル内の定義部分をVBAで強制削除してしまう方法の解説でした。あくまで、個人用に作ってみたものですが、文字列操作の勉強になったのではないかと思います。いかがでしたか?
今後、ZIPファイル操作部分も加えられるか検討してみたいと思っています。

Peplace関数で文字列全体からから特定の文字列を削除したり置き換えたりする方法がよくわかりました(^^)/ 設定を誤ると大変なことになってしまうので、バックアップを取りながら慎重にやるひつようがあることもよくわかりました。

【今回わかったことは】
・エラーのあるXMLファイル(UTF-8)から該当部分を削除する方法がわかりました
・文字列操作で「InStr」「InStrRev」「Val」「Mid」「Replace」関数を駆使する方法がわかりました

2021/11/20【自動削除ツール公開】しました。ただし「入力規則」の外部リンクエラーだけに絞ったものになっていますが、是非ご覧ください(^^)/


★★★ ブログランキング参加中! クリックしてね(^^)/ ★★★

【今後の記事について】

今回の記事はいかがだったでしょうか。皆さまのお役に立てたなら幸いです(^^;
「汎用でだれでも使えて活用できるように考えてる」というポリシーで、記事を継続して書いていきたいと思っています。どうぞよろしくお願いしますm(_ _)m

【検討中の今後の記事内容は・・・・】
・実務に役立つものを提供できるよう常に検討しています(^^ゞ
・その他雑記的に「プチネタなど」もいろいろ考えていきたいと思っています・・・・
・今後の記事にご期待ください(^^)/

過去記事のサンプルファイルをダウンロードできます

今回記事のサンプルファイルを登録しています
過去の記事で使用したサンプルファイルをダウンロードできるようにページを設置していますので、こちら(このリンク先)からご利用ください