Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
Range.Characters.Fontで1文字ずつ装飾情報を取得するときの高速化方法
投稿日時: 21/04/20 16:10:16
投稿者: QooApp

お世話になっております。
1つのセル(A1)の中に500文字程度のテキストが入っており、
下線・ボールド・斜体(イタリック)・色等の情報を1文字ずつ取得したい場合の高速化について質問します。
 
※下記コードは文字フォントの取得に限定していますが、実際は複数の装飾を取得しているものとご解釈ください。

Sub functest()
    
    Dim cnt As Long
    Dim pushText As String

    '開始時刻を出力
    Range("B1").Value = Now
    
    pushText = ""
    For cnt = 0 To Range("A1").Characters.Count
        pushText = pushText & Range("A1").Characters(cnt, 1).Font.Name & vbCrLf
    Next cnt
    
    '終了時刻を出力
    Range("B2").Value = Now
End Sub

'pushText 出力イメージ例
'MS 明朝
'MS 明朝
'MS 明朝
'GauLootFont
'GauLootFont
'MS 明朝
'MS 明朝
'MS 明朝
'…

 
現状、セル内で複数の「下線ボールド斜体(イタリック)」の各ON/OFFであったり、色の変更が部分的にあったりと、「1文字ずつ文字をチェックし、各装飾の有無を取得する」ほうが時間はかかるのですが成功しています。
 
しかし、セルの中で複数の装飾が発生すると、発生量に比例して動作に時間がかかります。
直接、セルのテキスト内部情報を毎回読みこんでいることが動作が重くなる原因だと思っているのですが、
自力で良い改善方法が思いつきません。
 
このプログラムの速度は改善可能なものでしょうか。

回答
投稿日時: 21/04/20 16:25:19
投稿者: WinArrow
投稿者のウェブサイトに移動

どのような目的なのか、どのくらいの頻度でジコウするのか?わかりませんが、
 
With 句で、セルを1回捕まえれば・・くらいしかもい付きませんが、
期待するような高速化は望めないと思います。

投稿日時: 21/04/20 16:46:49
投稿者: QooApp

WinArrow様ありがとうございます。
自分で使用するわけではないのですが、プログラムの実行回数は月10回程度*1回の資料のリテイク回数分程度という情報しかありません。
なので20回〜40回程度は実行されるものと解釈して作業を進めていますが、
セル内のテキストが増えれば増えるほど・装飾も増えれば増えるほど負荷が大きくなる傾向が出ております。
 
目的としてはセル内のテキストの見た目をhtmlのタグで同様に表現するために、
 
普通のテキスト<Bタグ>ここは太字のテキスト</Bタグ>普通のテキスト
 
というような文字列を生成する過程のチェック動作になります。
このプログラムが必要な箇所が2セルあり、それぞれ500〜1000文字程度の装飾付き文章ががっつり記載されています。とこんなことを書きつつ、もしかしてエクセルに外部プラグイン搭載したほうが楽なのか?と思いついたのでそんな感じのプラグインが無いかいったん探してみます。

回答
投稿日時: 21/04/20 17:04:49
投稿者: Suzu

チェック表なのであれば、
 
マクロはマクロでも、ユーザー定義関数にしてしまって、
縦に、文字位置
横に、チェックしたいキャラクターのパターン
 
を表示してしまってはどうでしょうか?
 
 
確認できていませんが、キャラクター情報が内部的に共通化されるかもです。
 
 
 
Function getCharaType(rng As Range, cnt As Long, typ As Long) As String
 
  If cnt > rng.Characters.Count Then Exit Function
  Select Case typ
    Case 1
      getCharaType = rng.Characters(cnt, 1).Font.Name
    Case 2
      getCharaType = rng.Characters(cnt, 1).Font.Color
    Case 3
      getCharaType = rng.Characters(cnt, 1).Font.Bold
    Case 4
      getCharaType = rng.Characters(cnt, 1).Font.Italic
    Case 5
      getCharaType = rng.Characters(cnt, 1).Font.Underline
  End Select
End Function
 
 
ん・・
html??
であれば、htmlや、mhtmで保存しタグを確認すれば良いのでは?

投稿日時: 21/04/20 17:17:41
投稿者: QooApp

Suzu様ありがとうございます。
 
全く知らないパターンの提案で驚きました。
mhtmで保存して、ということでしたのでやってみたのですが、
テキストに設定されている装飾がすべてCSS用の外部書き出し扱いになってしまいました。
装飾の入れ子や重なりが発生するとすべて分割した別々のCSSブロックになってしまい、ちょっとすぐの解決策としては改良コストが大きそうでした。
 
ですが、非常に面白いやり方だったので忘れないように記録させてもらいました。ありがとうございます。
 
Select文での対応についても、いったんやってみようと思います。ありがとうございます。
すぐにご回答できませんが、ありがとうございます。

回答
投稿日時: 21/04/20 17:48:38
投稿者: WinArrow
投稿者のウェブサイトに移動

文字を修飾する方法は、現在では、Cssで共通化するのが主流のようですよ。
Cssも含めてHtml化と考えてはいかがですか?

回答
投稿日時: 21/04/20 18:15:27
投稿者: simple

セル数はどのくらいですか?
頻度からすると、少々時間は掛かってもあまり凝ったことをする必要もないかもしれませんね。
 
2つほど、Tipsをメモします。
(1) r.Font.Name, r.Font.Bold, r.Font.Italic, r.Font.Underlineなどが、
   Nullを返した時には、種類が混在しているということなので、
   その時に限定して一文字ずつ見るようにする(プロパティ毎に異なりうる)と、
   幾分か、時間の節約になるのではないですか?
   セルを1文字ずつ見ていくというのは、Excelは不得意のようですから。
 
(2)セルのHTML(というよりXHTMLと言うべきか)を知るには、
   s = r.Value(xlRangeValueXMLSpreadsheet)
   とします。
   sの中の <Cell>タグの中身だけをみると、よいかもしれません。
   正規表現をこねくり回すとできるかもしれませんが、
   すでにできあがっているようですから、その延長線上で改善するのがよいと思います。
 
ちなみに、HTMLとの照合って、どうやるのですか、参考までに教えて下さい。

投稿日時: 21/04/20 19:58:24
投稿者: QooApp

WinArrow様
simple様ありがとうございます。
 
ご指摘の通り、CSSが保持可能であれば解決した案件でした。特にmhtmに変換するのは目から鱗でした。
しかし、わざわざエクセルのセルからタグ付きに変換する理由はCMS登録ページへの流し込みを想定している為です。
 
モーグのこの投稿用テキストボックスにも、特定のタグを打つ事でテキストの装飾が可能ですが、エクセルで
実際の表示と大差ない形を再現する事でCMSに疎いユーザでもそれくらいの装飾加工ができるようにすることが目的です。
個人的にはCMSに慣れてくれと思うところですが、諦めざるを得ない理由があってマクロ開発しています。
 
残念ながらCMSの入力欄にはHTML以外未対応で、CSSも読み込めません。結果直書きしか選択肢がありません。
 
CMSのフォーマットにはHTML対応のセルが二つしか無いので、マクロで処理しなければならない項目は2セルです。しかしそのセルが本文の為、入力される文字列は非常に多く、小学校などで配られる保護者へのプリント程度のテキスト量は耐えなければなりません。
 
自己開発中のプログラムでも、1文字づつ装飾があるか確認し、装飾がある場合は文字列変数へ1文字づつ加算する前にタグテキストを挿入するパワープレーで対応しています。一応稼働はするのですが、セル内を順番に精査する作業の為、非常に重たくなるという現象です。
 
現状、Suzu様とsimple様のアイデアが有力候補なので明日試してみます。
 
 
以下余談
外部プラグインや似たマクロを探したところ、フォントカラーに対応させる変換処理を作成した方のサイトを見つけました。残念ながら基本文法は自分と全く同じで処理時間は変わりませんでした。
 
HTML照合について、
Range.Characters.Font.*を使用しイタリック、ボールド、アンダーライン、フォントカラー、テキストサイズ等をT/F判定(または番号突合)して、該当項目があれば、文字列でタグ名を入力してるだけですが、説明として足りてますでしょうか。

回答
投稿日時: 21/04/20 22:32:16
投稿者: simple

説明ありがとうございます。
照合というより、それを元にHTMLテキストを作成しているということなんでしょうか。
色々なタグが入れ子になったときに、混乱しないんですか?
 
s = r.Value(xlRangeValueXMLSpreadsheet)に所定の変換をしていくことで、
HTML文字列を直接構成できそうな気がしますけど、どうなんでしょう。

投稿日時: 21/04/21 11:44:19
投稿者: QooApp

ご思案いただきました皆様へ
ご連絡遅くなり申し訳ありません。
すべてのパターンごとに処理時間を計測しましたのでご報告します。
 


Option Explicit

Sub main()

    Dim pushtxt As String
    Dim cnt As Long
    
    pushtxt = ""
    
    '開始時刻を出力
    Range("B1").Value = Now
    
    If (False) Then 'for文型処理か一括処理かのパターン変更用
        
        'for文の空回し = 平均0s
        For cnt = 1 To Range("A1").Characters.Count
            
            'セルフ初期案 = 平均10s
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Name & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Color & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Bold & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Italic & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Underline & vbCrLf
            'pushtxt = pushtxt & vbCrLf
            
            'WinArrow様案 = 平均6s
            With Range("A1").Characters(cnt, 1).Font
                pushtxt = pushtxt & CStr(.Name) & vbCrLf
                pushtxt = pushtxt & CStr(.Color) & vbCrLf
                pushtxt = pushtxt & CStr(.Bold) & vbCrLf
                pushtxt = pushtxt & CStr(.Italic) & vbCrLf
                pushtxt = pushtxt & CStr(.Underline) & vbCrLf
                pushtxt = pushtxt & vbCrLf
            End With
            
            'Suzu様案 = 平均16s
            'pushtxt = pushtxt & getCharaType(Range("A1"), cnt, 1) & vbCrLf
            'pushtxt = pushtxt & getCharaType(Range("A1"), cnt, 2) & vbCrLf
            'pushtxt = pushtxt & getCharaType(Range("A1"), cnt, 3) & vbCrLf
            'pushtxt = pushtxt & getCharaType(Range("A1"), cnt, 4) & vbCrLf
            'pushtxt = pushtxt & getCharaType(Range("A1"), cnt, 5) & vbCrLf
            'pushtxt = pushtxt & vbCrLf
            
            'simple様案@ = 平均9s ※
            '※事前にセルをチェックし、文字フォントの違いが無いと判断して、チェックをスキップしたと仮定した場合
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Color & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Bold & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Italic & vbCrLf
            'pushtxt = pushtxt & Range("A1").Characters(cnt, 1).Font.Underline & vbCrLf
            'pushtxt = pushtxt & vbCrLf
            
        Next cnt
        
    Else
        
        'simple様案A = 平均0s ※加工処理必須(とりあえず<Cell>で区切って内側を抜き出してみました)
        pushtxt = Split(Split(Range("A1").Value(xlRangeValueXMLSpreadsheet), "<Cell")(1), "</Cell>")(0)
        
    End If
    
    '終了時刻を出力
    Range("B2").Value = Now
    
    Range("A4").Value = pushtxt
    
End Sub


Function getCharaType(rng As Range, cnt As Long, typ As Long) As String
 
  If cnt > rng.Characters.Count Then Exit Function
  Select Case typ
    Case 1
      getCharaType = rng.Characters(cnt, 1).Font.Name
    Case 2
      getCharaType = rng.Characters(cnt, 1).Font.Color
    Case 3
      getCharaType = rng.Characters(cnt, 1).Font.Bold
    Case 4
      getCharaType = rng.Characters(cnt, 1).Font.Italic
    Case 5
      getCharaType = rng.Characters(cnt, 1).Font.Underline
  End Select
  
End Function


 
for文で1文字ずつ処理する系では、なんとWithブロック形式が最も早くなることがわかりました。
また、Suzu様案のFunctionにて外部処理させるコードも、初期は他より早く処理できた時もあったのですが、
今回の判定に使用した5種類文の文字装飾を施した文章では残念ながら時間が伸びてしまいました。
 
simple様のNull基準で処理の有無を設定する方法も効果的であることがわかりました。
 
for文で1文字ずつ処理する場合は
・不要な判定はスキップ
・withブロックで一括処理
が最適そうです。
 
simple様案のs = r.Value(xlRangeValueXMLSpreadsheet)は処理速度0sを達成し、高速処理向けであることがわかりました。現状のfor文でループ処理する式よりもこちら準拠で再構築したほうがよさそうな気がしました。
 
また、simple様案によって、
自分のマクロに文字記号系をhtml用特殊コードに変換する作業を怠っていたことが発覚しました。
皆様のご思案で大幅な改善が見込めます。
ありがとうございます。
 
他に何かご質問等ございますでしょうか。[/code]

回答
投稿日時: 21/04/21 14:50:05
投稿者: simple

計測ご苦労様でした。
計測の細部はよくわかりませんでしたが、全般的な感想として、
文字列連結が頻出するので、配列に書き込んで、
最後にJoinなりしたほうが速そうな印象です。
 
ところで、XMLSpreadsheet形式文字列に関して、
>現状のfor文でループ処理する式よりもこちら準拠で再構築したほうがよさそうな気がしました。
というところに個人的な興味を持ちました。
<B><I><U>はそのまま利用できそうですが、
Size,Faceなどが難点となるかもしれません。(そのまま使うわけにいかない気がしました)
 
なお、勘違いしていましたが、CMSに流し込むのは、最終のHTMLテキストではなく、
CMSが持つ簡易タグを含むものでいいわけですよね。HTMLに変換するのはCMSの仕事なので。
それを使ったいくつかの例をアップされれば、自動変換が議論できそうですね。
 
# HTMLの最近の動向は殆ど注意を払ってきませんでしたが、<Font>は非推奨(HTML5では廃止)
# になっているのですね。Styleを使って書く方式が普通になっているんでしょうか。
# CSSを使わないといっても、ヘッダ部分にスタイルを定義する、
# いわゆる内部CSSのようなものも含めて、一切CSSを使っていないって本当ですか?
# ちょっと考えにくい気がしました。(返答不要です)

投稿日時: 21/04/21 16:59:05
投稿者: QooApp

simple様
 
CMSに取り込む際のタグ情報の翻訳可能レベルについては、CMSシステムの提供元会社によって大幅に違いがあります。
そのため、htmlと全く同様のタグで指定可能なCMSと、モーグやFF14のプレイヤー投稿ページとかのように特殊なルールに沿って翻訳するべきCMSとそれぞれ存在します。
 
今回、自分が対応せざるを得ない案件に関してはタグの書き方はhtml完全準拠なのですが、ヘッダータグとボディタグが死んでおり、原則としてボディタグより内側にあるタグ(p/br/a/img/b/i/u等々)しか設定できない仕様となっております。また、簡易scriptを保持させてJavascript等の挙動を再現させる能力もありません。(この機能はデータ破壊のリスクがある為実装されている方が稀)さらに突っ込んだ情報を持たせたければ、今回のCMSはStyleでタグ内部に追記するしか対応していないモデルになります。
 
様々な装飾翻訳パターンこそあれど、いったんエクセルが出力可能な結果情報から各提供CMSのルールに最適化させる方が二次転用が効きそうだと思った次第です。
そのため、直接html変換が難しいタグの変換も含めて一度マスターライブラリを作ってみたほうが、マスターライブラリの翻訳後イメージを変更するだけで様々なパターンに対応できるかなと思いました。
 
また、仰る通りで、文字結合に関しては負荷が大きいこともわかりましたので配列結合等の処理を施させていただきます。
 
今回は自分の中でも非常に大きな収穫で本当に勉強になりました。ありがとうございます。
今回はいったんこれで閉めさせていただきます。皆様多数のご提案ありがとうございました。
 

引用:
それを使ったいくつかの例をアップされれば、自動変換が議論できそうですね。

 
作成はするんですが、めっちゃくちゃ時間かかると思います!w
これは将来的に別のコラムを作成して報告させていただければ幸いです(まずは作成しなければ・・)