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

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

ただいまの
回答率

88.64%

オートメーション エラーです。起動されたオブジェクトはクライアントから切断されました

解決済

回答 1

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 12K+

SugiuraY

score 249

過去に正規表現により1文字違いの場合でも全て真として
値を取得する方法を相談させて頂きました。
山田太郎の場合の正規表現は

.田太郎|山.太郎|山田.郎|山田.郎

山田太郎のように検索すべき対象の文字列が
ds.Range(D:D)に500個程度あり

今朝、山田太一はパンを食べましたのような検索されるべき対総の文字列が
ds.Range(H:H)
に150程度あります。
ただし、この検索されるべき対象の文字列は上記のように短い文のこともあれば
1000文字程度の長い文もあります。

【ご質問】
下記の処理を実行した結果、2~3分程度エクセルがうなり、
"オートメーション エラーです。起動されたオブジェクトはクライアントから切断されました"
のエラーとともに処理が中断しました。意図した出力は3つぐらいは得られていたので
コード自体には問題がないと考えております。

ループの構造等に問題がありエラーが出力されて処理が中断されてしまうため、正しい処理であってもあるべき処理ではないのか、それともそもそも500 (X 正規表現の数) X 150 (文字数)を分だけvbaを使ってエクセルで実行すること自体に無理があるのでしょうか?

あまりエクセルが得意ではないため、特に後者について、感覚的に分からない部分があるため、アドバイスをいただけるとうれしいです。(エクセルでそれをやらせるのは無理があるよとかでもいいです。)

【追伸】
実際にはいまトライアルのため検索されるべき文字列の対象が500個程度となっていますが
実際には1万個を超えるデータです。

前略
   Set reg = CreateObject("VBScript.RegExp")

     o = 1
     For p = 2 To maxValG + 1
      namePt = Replace(ds.Range("D" & p).Value, " ", "")
      nameLen = Len(namePt)

       For q = 2 To maxValI + 1

          For t = 1 To nameLen
          Patn = Patn + WorksheetFunction.Replace(namePt, t, 1, ".") + "|"
          Next
          Patn = Mid(Patn, 1, Len(Patn) - 1)

          reg.Pattern = Patn

        If reg.Test(ds.Range("H" & q)) = True Then
        pts.Cells(o, 1) = ds.Range("G" & p).Value
        pts.Cells(o, 1).Interior.Color = RGB(217, 217, 217)

        pts.Cells(o, 2) = ds.Range("G" & q).Value
        pts.Cells(o, 2).Interior.Color = RGB(217, 217, 217)

        pts.Cells(o, 3) = namePt
        pts.Cells(o, 3).Interior.Color = RGB(217, 217, 217)
        o = o + 1
        End If
       Next
     Next
後略
  • 気になる質問をクリップする

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

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

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 1

checkベストアンサー

+2

詳しくは見ていませんが、Patnを初期化せずに使っているので、延々と結合されてしまっているのが原因ではないでしょうか。
Patn編集ループ前に初期化してあげてみてください。

Patn = ""        ' ←追加
For t = 1 To nameLen
    Patn = Patn + WorksheetFunction.Replace(namePt, t, 1, ".") + "|"
Next
Patn = Mid(Patn, 1, Len(Patn) - 1)

追記
処理時間がかかるような場合は、DoEventsを適宜入れるようにしてください。
Excelが固まるのが防止できますし、途中で中断することも可能になりますので。
あまり入れすぎると遅くなる可能性もあるので、1つ目のループの最後あたりに入れるなどでよいかと思います。

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/10/20 22:30

    ご指摘ありがとうございます!
    昔、先輩に教わった事を鵜呑みにしていたのですが、
    今回のケースですと高速化の効果は無いようですね。
    失礼しました...

    Sheets("○○")等とアクセスしている場合は効果が出るようです。
    勉強させて頂きました。
    https://excel-ubara.com/excelvba4/EXCEL228.html

    キャンセル

  • 2018/10/21 00:38

    しいて言うなら`.Cells(o, 1)`は`.Cells.Item(o, 1)`なので
    `.Cells`をWithや変数でキャッシュしておき、`.Item`でアクセスすると若干早くなりますね

    キャンセル

  • 2018/10/30 21:31

    コメントありがとうございます。
    変数にキャッシュすることで速度に変化があるのですね、処理時間を計測したら確かに若干早くなりました!件数が多いほど、効果が期待できそうです。

    キャンセル

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

  • ただいまの回答率 88.64%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • トップ
  • VBAに関する質問
  • オートメーション エラーです。起動されたオブジェクトはクライアントから切断されました