質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.48%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

1回答

1658閲覧

文字列検索するマクロを実行すると「XMLエラーがありました。」というエラーメッセージが表示される。

sishou

総合スコア9

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2020/03/10 04:12

実現したいこと

マクロ実行して保存したファイルを開こうとすると、エラーメッセージが表示がされて開かないのを回避したい。

発生している問題

先日、こちらでExcel VBAのマクロを教えていただき、問題なく動作していました。
ところが、フォームが変更になったのでコードの一部を変更して実行したところ、

"削除されたパーツ: /xl/sharedStrings.xml パーツに XML エラーがありました。 (文字列) 要素の終了タグ内の名前と開始タグ内の要素の型は一致している必要があります。場所は、行 779、列 26 です。
削除されたレコード: /xl/worksheets/sheet1.xml パーツ内のセル情報"

というメッセージが表示されてファイルが開けなくなりました。
原因がわからないので、お教えいただきますと幸いです。

該当のソースコード

Option Explicit

Type USRSTR
OrgStr As String '元の文字列
ZenStr As String '全角文字列
HanStr As String '半角文字列
ZenLen As Long '全角文字列の文字数
HanLen As Long '半角文字列の文字数
End Type

Public Sub 文字列検索()
Application.ScreenUpdating = False
Dim maxrow As Long 'K列最大行
Dim maxrow2 As Long 'P列最大行
Dim ustrs() As USRSTR '検索文字の配列
Dim ucnt As Long '検索文字の数
Dim wrow As Long
maxrow = Cells(Rows.Count, "K").End(xlDown).Row
maxrow2 = Cells(Rows.Count, "P").End(xlUp).Row
If maxrow2 < 2 Then
MsgBox "検索文字が入力されていません。"
Exit Sub
End If
Dim stime As Variant
Dim etime As Variant

'検索文字列を配列へ格納する ucnt = 0 For wrow = 2 To maxrow2 If Cells(wrow, "P").Value <> "" Then ReDim Preserve ustrs(ucnt) ustrs(ucnt).OrgStr = Cells(wrow, "P").Value ustrs(ucnt).ZenStr = StrConv(ustrs(ucnt).OrgStr, vbWide) ustrs(ucnt).HanStr = StrConv(ustrs(ucnt).OrgStr, vbNarrow) ustrs(ucnt).ZenLen = Len(ustrs(ucnt).ZenStr) ustrs(ucnt).HanLen = Len(ustrs(ucnt).HanStr) ucnt = ucnt + 1 End If Next '検索対象文字列(K列)について全行繰り返し For wrow = 2 To maxrow If Cells(wrow, "K").Value <> "" Then 'L列1行の処理 Call one_line(Cells(wrow, "K"), ustrs) End If Next MsgBox "検索を完了しました。"

End Sub
'1行の処理
Private Sub one_line(ByRef rg As Range, ByRef ustrs() As USRSTR)
Dim i As Long
Dim trg_ZenStr As String
Dim trg_ZenLen As Long
Dim pos As Variant
Dim ustr As USRSTR
trg_ZenStr = StrConv(rg.Value, vbWide)
trg_ZenLen = Len(trg_ZenStr)
'全ての検索文字列を処理する
For i = 0 To UBound(ustrs)
ustr = ustrs(i)
'1文字列の処理
Call one_string(rg, ustr, trg_ZenStr, trg_ZenLen)
Next
End Sub
'1文字列の処理
Private Sub one_string(ByRef rg As Range, ByRef ustr As USRSTR, ByRef trg_ZenStr As String, ByVal trg_ZenLen As Long)
Dim i As Long, j As Long
Dim update_len As Long
Dim pos As Variant
j = 1
For i = 1 To trg_ZenLen
pos = InStr(i, trg_ZenStr, ustr.ZenStr, vbBinaryCompare)
If pos = 0 Then Exit Sub
pos = InStr(j, rg.Value, ustr.OrgStr, vbTextCompare)
If pos = 0 Then Exit Sub
Call get_update_len(pos, rg, ustr, update_len)
If update_len <> 0 Then
rg.Characters(start:=pos, length:=update_len).Font.Size = 16
rg.Characters(start:=pos, length:=update_len).Font.ColorIndex = 3
rg.Characters(start:=pos, length:=update_len).Font.Bold = True
End If
j = pos + update_len
Next
End Sub
'1文字列の更新サイズ取得
Private Sub get_update_len(ByVal start_pos As Variant, ByRef rg As Range, ByRef ustr As USRSTR, ByRef update_len As Long)
Dim i As Long, j As Long
Dim str As String
Dim pos As Variant
If ustr.ZenLen = ustr.HanLen Then
update_len = ustr.ZenLen
Exit Sub
End If
For i = ustr.ZenLen To ustr.HanLen
str = Mid(rg.Value, start_pos, i)
pos = InStr(1, str, ustr.OrgStr, vbTextCompare)
If pos <> 0 Then
update_len = i
Exit Sub
End If
Next
update_len = 0
End Sub

以上、よろしくお願いいたします。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Zuishin

2020/03/10 04:22

意味もわからずコピペするとちょっとした改修にも対応できず人に聞くことになりますね。エラーが出なかった状態に戻し、理解した上で手を着けたらいいと思います。 今はまだ回答が付くかもしれませんが、そのうちハシゴが外れ、とんでもなく緊急かつ重要な場面で責任を取らなければならなくなるでしょう。
yureighost

2020/03/10 05:12

そもそも何をやりたい処理なのかよくわからないので判断に困るのですが、 開けなくなるのは実行したExcelマクロファイルそのものですか? とりあえずK、P列に文字列入れて実行したところ、 KとPの値が一致しているとKの値が強調表示されたようになる動作は確認しましたし、 そこで保存して終了させても再度開けなくなるという不具合は起きませんでした。
sishou

2020/03/10 05:54

ご指摘のようにこのマクロはK列の文字列からP列に入力されている文字を探し出し、その文字を強調表示するものです。 そして、開けなくなるのはファイルそのものです。 開こうとすると上記のようなエラーメッセージが出て、中身が空のものが開きます。 今回修正したのは上記コードの42、44行目、 "If Cells(wrow, "K").Value <> "" Then" "Call one_line(Cells(wrow, "K"), ustrs)" この部分を"L"から"K"に修正しました。 この修正を行って実行、保存したところ、エラーメッセージが出て正しく開かなくなりました。 さらに不明点等あればお書きください。 答えさせていただきます。 よろしくお願いいたします。
yureighost

2020/03/10 06:43

ソースを持っているということはバックアップは取られてたと思うのですが、 やり直しても必ず再現するのですか? そしてK列でExcelの方でセル結合等、何か効果は与えてないでしょうか。 こちらの何も設定していないシート環境だと特に不具合はないので。
sishou

2020/03/10 08:36

申し訳ありません。 何回か修正を繰り返していたら直りました。 修正個所は同じなので、原因はわからずじまいでした。 セルの結合やセル内での開業がありましたが、それらは問題ありませんでした。 よくわからない終わり方になってしまいましてすみません。 ありがとうございました。
guest

回答1

0

自己解決

申し訳ありません。
何回か修正を繰り返していたら直りました。
修正個所は同じなので、原因はわからずじまいでした。
セルの結合やセル内での開業がありましたが、それらは問題ありませんでした。
よくわからない終わり方になってしまいましてすみません。
ありがとうございました。

投稿2020/03/10 08:43

sishou

総合スコア9

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.48%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問