goo blog サービス終了のお知らせ 

半角チルダ

ExcelVBA、その他。
覚え書きや、補足資料などのスクラップブック。
end-u(1037781)

■「条件付き書式の設定」で赤色に設定された数値も検索

2011-11-05 21:00:00 | scrap
条件付き書式で現れた「結果」(セルが赤く塗られた,フォントの書式が変わった,など)を検索したり検出する方法は,..
マクロを使って出来なくもない..。(xl2003環境)

Option Explicit
'-----------------------------------------------------------
Sub prep() '準備。Bookを追加しSheet1のA1:A50に条件付き書式を設定。
  With Workbooks.Add(xlWBATWorksheet).Sheets(1).Range("A1:A50")
    .FormulaR1C1 = "=INT(RAND()*20)+1"
    .Value = .Value
    .FormatConditions.Add(Type:=xlCellValue, _
               Operator:=xlBetween, _
               Formula1:="5", _
               Formula2:="10").Font.Color = vbRed
  End With
End Sub
'-----------------------------------------------------------
Sub test() 'prep後BookをActiveにして実行。
  Dim ws As Worksheet
  Dim tmp As String
  Dim buf As String
  Dim n  As Long
  Dim r  As Range
  
  Application.ScreenUpdating = False
  '作業用mhtファイル名を設定。 _
   同名既存ファイルがあれば上書きするので注意。
  tmp = Application.DefaultFilePath & "\temp.mht"
  Set ws = ActiveSheet
  ActiveWorkbook.PublishObjects.Add( _
      xlSourceSheet, tmp, _
      ws.Name, "", _
      xlHtmlStatic).Publish True
  
  '作業用mhtファイルOpen。
  n = FreeFile
  Open tmp For Input As #n
  buf = StrConv(InputB(LOF(n), #n), vbUnicode)
  Close #n

  '---置換作業---
  '途中改行があれば削除。
  buf = Replace$(buf, "=" & vbCrLf, "")
  'とにかく"ignore:"を消せばいいかな。
  buf = Replace$(buf, "mso-ignore:", "")
  '--------------
  
  '作業ファイル書き込み直してOpen、検索作業。
  n = FreeFile
  Open tmp For Output As #n
  Print #n, buf
  Close #n
  
  With Application.FindFormat
    .Clear
    .Font.Color = vbRed
  End With
  
  With Workbooks.Open(tmp)
    With .Sheets(1).UsedRange
      .Replace What:="*", _
           Replacement:="#n/a", _
           LookAt:=xlPart, _
           SearchFormat:=True
      On Error Resume Next
      Set r = .SpecialCells(xlCellTypeConstants, xlErrors)
      On Error GoTo 0
    End With
    If Not r Is Nothing Then
      ws.Activate
      ws.Range(r.Address(0, 0)).Select
    End If
    .Close False
  End With
  '作業用mhtファイル削除。
  Kill tmp
  Set r = Nothing
  Set ws = Nothing
  Application.ScreenUpdating = True
End Sub


■VBA Replace(buf, "ignore:", "")で既出。scrap重ねですorz

ついでに
■RegisterClipboardFormatA("HTML Format")の使い回しでhttp://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=70352;id=excel

Comments (2)    この記事についてブログを書く
  • X
  • Facebookでシェアする
  • はてなブックマークに追加する
  • LINEでシェアする
« ■xl2007:オートシェイプの文... | TOP | ■New DataObject »
最新の画像もっと見る

2 Comments(10/1 コメント投稿終了予定)

コメント日が  古い順  |   新しい順
Unknown (cj_mover(1013438))
2011-11-27 22:10:56
御無沙汰してます。お変わりなく御活躍のようで何よりです。
> .PublishObjects.Add()
とても勉強になります。
最近、.Characters.Fontの大量操作を別プロセスで実現する方法を色々考えていたのですが、
これ、使えそうです。
#ぃゃHTMLやRegExpを基本から勉強し(直し)ている処なので
#検証し切れていない私としては見通しでしか語れない、という。
取りあえず(私が書いたのも)動いていますし、
応用し易く、動作も軽く、結構CoolなTipsだと思いました。
いつも欠かさず拝見しています。また勉強させてください。
それてはまた。

返信する
Unknown (end-u)
2011-11-28 01:45:07
cj_moverさん、お久し振りですね :)
コメントありがとうございます。

>.Characters.Fontの大量操作..
というとqa/7067351でしょうか。
#最近チェックしてなくて..不義理ですみませんorz
..ムム..。ちょっと面白そうなテーマですね。
でも既に終わってる感。


>活躍
だなんてとんでもないです。
以前にまた輪をかけて閑散投稿ですし、月刊~も危ういですし..
内容もあまり進歩がなくなってきてるのを感じてます。


それはそうと、最近はcj_moverさんの回答もあまりお見かけする機会が少なく..
..というか何故か私がブックマークさせてもらってる方全般に言えるのですけれども..それはちょっと寂しい気が。;(
また以前のように皆さんの回答で勉強させてもらう機会が増えれば良いなあ、と思ってます。
今後ともよろしくお願いします。:D
返信する

post a comment

サービス終了に伴い、10月1日にコメント投稿機能を終了させていただく予定です。
ブログ作成者から承認されるまでコメントは反映されません。

Recent Entries | scrap