Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2086 / 13645 ツリー ←次へ | 前へ→

【70029】VBAで特定のプロパティを持つセルを選択 ヤムチャ 11/10/11(火) 17:49 質問[未読]
【70031】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/11(火) 18:31 発言[未読]
【70032】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/11(火) 18:34 発言[未読]
【70033】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/11(火) 19:02 発言[未読]
【70034】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/11(火) 19:04 回答[未読]
【70036】Re:VBAで特定のプロパティを持つセルを選択 ヤムチャ 11/10/11(火) 20:30 お礼[未読]
【70038】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/12(水) 5:51 発言[未読]
【70043】Re:VBAで特定のプロパティを持つセルを選択 ヤムチャ 11/10/12(水) 11:10 質問[未読]
【70044】Re:VBAで特定のプロパティを持つセルを選択 ヤムチャ 11/10/12(水) 11:30 発言[未読]
【70047】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/12(水) 12:00 発言[未読]
【70046】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/12(水) 11:54 発言[未読]
【70048】Re:VBAで特定のプロパティを持つセルを選択 ヤムチャ 11/10/12(水) 13:15 発言[未読]
【70049】Re:VBAで特定のプロパティを持つセルを選択 UO3 11/10/12(水) 15:47 発言[未読]

【70029】VBAで特定のプロパティを持つセルを選択
質問  ヤムチャ  - 11/10/11(火) 17:49 -

引用なし
パスワード
   環境 EXCEL2003

はじめまして。
下記に付いて教えて下さい。

下記動作をするVBAを作っています。
セルに設定されているプロパティをみて、特定のプロパティごとにセルに色をつける。
下記の例だと、表示形式(NumberFormatLocal)をみて、色をつけています。

問題点
1.セルの数が増えれば増えただけループ回数が多くなり時間がかかります。
2.該当の表示形式かどうか、if文で判断しているため、条件を満たしても後続の判定処理が行われる。
 ⇒一番上のif文の条件("G/標準")だとしても、2個目以降("#,##0;[赤]-#,##0")の条件式が実行される。
 ⇒select case 文で置き換えても処理ステップ数は変わらないと思っています。

なので、特定の範囲の中で、NumberFormatLocal="G/標準"のセルを選択できるような方法はないでしょうか?
又、条件が増えても処理が重くならない書き方はあるでしょうか?


    '処理範囲の設定
  XLWS.Range(strStartcell, strEndcell).Select

  '処理実行
   For Each cel In XLWS.Range(strStartcell, strEndcell)
      
      If cel.NumberFormatLocal = "G/標準" Then
        With XLWS.Range(cel.Address).Interior
          .ColorIndex = 5 'BLUE
        End With
        Cell_flg = True
      End If

      If cel.NumberFormatLocal = "#,##0;[赤]-#,##0" Then
        With XLWS.Range(cel.Address).Interior
          .ColorIndex = 18 'Plum
        End With
        Cell_flg = True
      End If
            ・
            ・
            ・
            ・
            ・
    Next cel

【70031】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/11(火) 18:31 -

引用なし
パスワード
   ▼ヤムチャ さん:

こんばんは

書式についてはSpecialCellsではサポートされていませんので領域内を地道に捜すしかないと思います。
ただ、2003であれば、以下が可能です。

・領域を選択
・編集->検索
・オプション(T)
・検索文字列(N)にはなにも指定せず
・書式(M)で表示書式、標準を選び
・次を検索 さらに 次を検索

これをマクロ記録しますとFindFormatを使ったFind/FindNextの検索コードが
生成されます。

【70032】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/11(火) 18:34 -

引用なし
パスワード
   ▼ヤムチャ さん:

追伸です。
書式設定は結構、負荷が大きいのでセル毎に設定するよりまとめて設定したほうが
時間は短縮されます。
該当のセルの数にもよりますが、上記で取得したセルオブジェクトをUnionで結合させておき
最後に、その結合領域に対して色をつけるという方式がよろしいかと。

【70033】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/11(火) 19:02 -

引用なし
パスワード
   ▼ヤムチャ さん:

わぁ、一部間違い。ごめんなさい。
書式検索の場合、FndNextは使えません(きっと)
Findのみでやりくりすることになります。

【70034】Re:VBAで特定のプロパティを持つセルを選...
回答  UO3  - 11/10/11(火) 19:04 -

引用なし
パスワード
   ▼ヤムチャ さん:

一例です。

Sub Sample()
  Dim myA As Range
  Dim c As Range, f As Range, r As Range
  
  Set myA = Range("A1:C20")  '実際の領域に
  
  Application.FindFormat.NumberFormatLocal = "G/標準"
  
  Set c = myA.Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
        SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, _
        SearchFormat:=True)
  If c Is Nothing Then
    MsgBox "標準書式のセルはありません"
  Else
    Set f = c
    
    Do
      If r Is Nothing Then
        Set r = c
      Else
        Set r = Union(r, c)
      End If
      
    Application.FindFormat.NumberFormatLocal = "G/標準"
    
    Set c = myA.Find(What:="", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
          SearchDirection:=xlNext, MatchCase:=False, MatchByte:=False, _
          SearchFormat:=True, After:=c)
      
    Loop While c.Address <> f.Address
    
    r.Interior.ColorIndex = 18 'Plum
    
  End If
  
  Set myA = Nothing
  Set r = Nothing
  Set c = Nothing
  Set f = Nothing
  
End Sub

【70036】Re:VBAで特定のプロパティを持つセルを選...
お礼  ヤムチャ  - 11/10/11(火) 20:30 -

引用なし
パスワード
   回答及び例示までありがとうございます。
最初の2つの回答を頂き作成しておりました。
FIMDNEXTが動かないところで四苦八苦しておりましたが;。
私の作成した例は下記ですが、UC3さんとほぼ同じロジックかと思います。
ありがとうございました。

Function aaa()
  Dim SercfArea As Range
  Dim FoundCell As Range, FirstCell As Range, Target As Range
  Dim strStartcell As String, strEndcell As String
  '処理範囲の設定
  strStartcell = "A1"
  strEndcell = "D30"
  Set SercfArea = Range(strStartcell, strEndcell)
  
  '検索条件の初期化
  Application.FindFormat.Clear
  '処理実行
  Application.FindFormat.NumberFormatLocal = "G/標準"
  Set FoundCell = SercfArea.Find(What:="", LookIn:=xlFormulas, LookAt:=xlWhole _
    , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , MatchByte:=False, SearchFormat:=True)
 
  If FoundCell Is Nothing Then
  Else
    Set FirstCell = FoundCell
    Set Target = FoundCell
    Do
      Set FoundCell = SercfArea.Find(What:="", After:=FoundCell, LookIn:=xlFormulas _
      , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
      , MatchByte:=False, SearchFormat:=True)
      
      If FoundCell.Address = FirstCell.Address Then
        Exit Do
      Else
        Set Target = Union(Target, FoundCell)
       Debug.Print FoundCell.Address
      
      End If
    Loop
  End If
  
  Target.Interior.ColorIndex = 5 'BLUE
End Function

【70038】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/12(水) 5:51 -

引用なし
パスワード
   ▼ヤムチャ さん:

年とともに、目が覚める時間が早くなっています。

アップされたコード、実際には問題がないと思いますが
仮に最初の検索でNothingだった場合、TargetもNothingですから、最後の書式設定でエラーになります。

それと

If FoundCell Is Nothing Then
Else

この2行は

If Not FoundCell Is Nothing Then
  
このように1行にできます。

【70043】Re:VBAで特定のプロパティを持つセルを選...
質問  ヤムチャ  - 11/10/12(水) 11:10 -

引用なし
パスワード
   実際に組み込んでみたのですが、エラーがでます。
再度お力を貸して下さい。

Set Target = Union(Target, FoundCell)
部分で実行時エラー1004 Uionメソッドは失敗しました。'Global'オブジェクト
となります。

実行は、ブックAに本マクロを組み込み、別処理でブックBのシートを操作します。
昨日提示したコードは問題なく動いてましたので、
ブックの参照等がずれている事はないと考えています。

何を疑えば(調べれば)だけでもご教示頂ければと思います。
よろしくお願いいたします。

  Dim SerchArea As Range
  Dim FoundCell As Range, FirstCell As Range, Target As Range
    '検索シートの設定
  Set XLWS = XLWB.Worksheets(strSheetname)
  '処理セルの設定
  Set SerchArea = XLWS.Range(strStartcell, strEndcell)

  '検索条件の初期化
  Application.FindFormat.Clear
  '処理実行
  Application.FindFormat.NumberFormatLocal = "@"
  Set FoundCell = SerchArea.Find(What:="", LookIn:=xlFormulas, LookAt:=xlWhole _
    , SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    , MatchByte:=False, SearchFormat:=True)
 
  If FoundCell Is Nothing Then
  Else
    Set FirstCell = FoundCell
    Set Target = FoundCell
    Do
      Set FoundCell = SerchArea.Find(What:="", After:=FoundCell, LookIn:=xlFormulas _
      , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
      , MatchByte:=False, SearchFormat:=True)
      
      If FoundCell.Address = FirstCell.Address Then
        Exit Do
      Else
        Set Target = Union(Target, FoundCell)
      End If
    Loop
    Target.Interior.ColorIndex = 5
  End If

【70044】Re:VBAで特定のプロパティを持つセルを選...
発言  ヤムチャ  - 11/10/12(水) 11:30 -

引用なし
パスワード
   自己解決?しました

エクセルブック等オブジェクトを下記のように設定しています。
Public XLAP As Object
Public XLWB As Object
Public XLWS As Worksheet

それぞれ次のよう設定を行っています。
' Excelのアプリケーション作成
Set XLAP = CreateObject("Excel.Application")
' 指定したExcelファイルを開く(書式調査を行うブック)
Set XLWB = XLAP.Workbooks.Open(ブックB)

UnionはApplicationに属する(?)←どう表現していいのかわかりません
ので、
Set Target = XLAP.Union(Target, FoundCell)
と書き換えました。
又、Application.となっている箇所をXLAPに置き換えました。

正解なのか自信がありませんが、表面上はこれで動いているようです

【70046】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/12(水) 11:54 -

引用なし
パスワード
   ▼ヤムチャ さん:

こんにちは

実行時エラー1004 Uionメソッドは失敗しました。'Global'オブジェクト
これがでるのは、Unionしようとした領域が、異なるシートにある場合ですね。

ざっとコードを眺めただけですが、エラーにはならないようにも思えます。
でもエラーになったんですよね。

少なくとも、このUnionの前に、SerchArea.Find でみつかったFoundCellを
Set Target = FoundCell してますから Targetには SerchArea 内のセルが
はいっているはずですし、そこと 次のSerchArea.Find でみつかったFoundCell
は、おなじシートですので・・・・

もう少しコードをおっかけてみます。

【70047】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/12(水) 12:00 -

引用なし
パスワード
   ▼ヤムチャ さん:

>自己解決?しました

祝着です。

それとは別に・・・
だめということじゃないんですが、別ブックを「別エクセル」で開く理由は?
同じエクセルで開けば、普通に Union でいけますよ。
(そのあたりの仕組みは、推察されている通りです)

【70048】Re:VBAで特定のプロパティを持つセルを選...
発言  ヤムチャ  - 11/10/12(水) 13:15 -

引用なし
パスワード
   Set Target = Union(Target, FoundCell)

ここで、はねられるという事は
Targetに入っている物(最初にFindした物)と、追加されるRageオブジェクトが異なる。
Findで異なる物は、2回目のFindで、After:=FoundCellとしているぐらいなんですよねぇ。
最初と2回目に渡される、Rangeオブジェクトのプロパティの差分をとれれば正解が見えるような気がするのですが、差分の出し方がわからない^;

エクセルを分けている理由は特にありません。
2つのブックを、XLWSといったオブジェクトを扱う時、
技術不足でこの書き方しかしらないためです。

このやり方ならちゃんと指定すれば意図通り動く&
実行先のエクセルがクラッシュした時に、元のエクセルを巻き込まない?かなと。

【70049】Re:VBAで特定のプロパティを持つセルを選...
発言  UO3  - 11/10/12(水) 15:47 -

引用なし
パスワード
   ▼ヤムチャ さん:

こんにちは

Unionを別エクセルで修飾し、XLAP.Union(Target, FoundCell)
と変更されたということで、ご理解されているのでは?と思っているんですが。

ご理解の通り、Union は、その前に 「今動いているエクセルの」が省略されています。
で、コードとしては Application。
VBAでApplication というと、「今動いているエクセル」ということになります。

ですから、「今動いているエクセル内のアドレスを結合」というメソッドの引数が
「別エクセルのアドレス」なので、これはおかしいぞ! ということになります。
正しくは「別エクセルの領域を結合、結合領域は別エクセルのこことここ」と記述することが必要なんです。

お使いの別エクセル起動コードとは異なりますし、既存ブックではなく、新規ブックにしていますが
以下のTestOK と TestNG でその違いを感じていただければ幸甚です。

なお、

>エクセルを分けている理由は特にありません。
>2つのブックを、XLWSといったオブジェクトを扱う時、
>技術不足でこの書き方しかしらないためです。

いえいえ、こちらのほうが技術的には「高度」ですよ。
ただ、そうしなければいけない要件があるときに使います。
通常であれば同一エクセル内で、ブックを読み込みます。
以下の 同じエクセル のコードは TestNG とにていますが、こちらはエラーにはなりません。

Sub TestOK()
  Dim wb As Workbook
  Dim r As Range
  Dim xlApp As Application
  Set xlApp = New Application
  xlApp.Visible = True
  Set wb = xlApp.Workbooks.Add
  Set r = xlApp.Union(wb.Sheets(1).Range("A1"), wb.Sheets(1).Range("B1"))
  MsgBox r.Address
End Sub

Sub TestNG()
  Dim wb As Workbook
  Dim r As Range
  Dim xlApp As Application
  Set xlApp = New Application
  xlApp.Visible = True
  Set wb = xlApp.Workbooks.Add
  Set r = Union(wb.Sheets(1).Range("A1"), wb.Sheets(1).Range("B1")) 'ここでエラーになるはず
  MsgBox r.Address
End Sub

Sub 同じエクセル()
  Dim wb As Workbook
  Dim r As Range
  Set wb = Workbooks.Add
  Set r = Union(wb.Sheets(1).Range("A1"), wb.Sheets(1).Range("B1")) 'エラーにはならない
  MsgBox r.Address
End Sub

2086 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free