Excel VBA質問箱 IV

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

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


1036 / 13644 ツリー ←次へ | 前へ→

【76659】条件別で選択するシートを変え、シートの中にある検索ワードを検索 さとちぃ 15/2/24(火) 16:14 質問[未読]
【76662】Re:条件別で選択するシートを変え、シート... kanabun 15/2/24(火) 17:37 発言[未読]
【76663】Re:条件別で選択するシートを変え、シート... kanabun 15/2/24(火) 20:06 発言[未読]
【76664】Re:条件別で選択するシートを変え、シート... さとちぃ 15/2/25(水) 10:05 質問[未読]
【76665】Re:条件別で選択するシートを変え、シート... kanabun 15/2/25(水) 10:36 発言[未読]
【76666】Re:条件別で選択するシートを変え、シート... kanabun 15/2/25(水) 10:38 発言[未読]
【76667】Re:条件別で選択するシートを変え、シート... さとちぃ 15/2/25(水) 11:23 質問[未読]
【76668】Re:条件別で選択するシートを変え、シート... kanabun 15/2/25(水) 11:42 発言[未読]
【76669】Re:条件別で選択するシートを変え、シート... さとちぃ 15/2/25(水) 14:23 お礼[未読]
【76670】Re:条件別で選択するシートを変え、シート... さとちぃ 15/2/25(水) 15:15 質問[未読]
【76673】Re:条件別で選択するシートを変え、シート... kanabun 15/2/25(水) 17:00 発言[未読]
【76684】Re:条件別で選択するシートを変え、シート... さとちぃ 15/2/26(木) 15:47 質問[未読]

【76659】条件別で選択するシートを変え、シートの...
質問  さとちぃ  - 15/2/24(火) 16:14 -

引用なし
パスワード
   VBA初心者です。
以下のような内容を実行したいのですが、プログラム作成に苦戦しております。

シート名”会社情報一覧”のシートにて、検索したい会社名を選択、マクロの実行ボタンを
押すと、会社名の載っている別のシートを選択し、そこで検索をかけ、ヒットしたセルに
色を付ける。


シート名”会社情報一覧”

  A        B        C         D         E
1 会社名    リンク      Aグループ企業  Bグループ企業  Cグループ企業
2 ZF株式会社 マクロを実行する   ○
        リンクボタン
3 XYZ株式会社 マクロを実行する            ○
        リンクボタン


上の表の意味として、ZF株式会社の情報は、シート名”Aグループ企業”に載っているということです。
そのため、Aグループ企業のシートに飛んで、その中にあるZF株式会社のセルを探して色を付けるという
作業になります。


Sub オールラウンド拠点情報からのSC情報検索()
  Dim Target As String    '文字列を表示する引数Targetを宣言
  Dim FoundCell As Range   '文字列を表示する引数FoundCellを宣言
  Dim SearchArea As Range  '文字列を表示する引数SearchAreaを宣言
  Dim Addr As String
  Dim FoundAddr() As String
  Dim i As Long
  
  Target = ActiveCell
  If Target = "False" Then Exit Sub 'もしも入力した文字がない場合は、プログラムを終了
   
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row

  If Cells(i, 3) = "○"
  Worksheets("Aグループ企業").Select
  End If
  
  If Cells(i, 4) = "○"
  Worksheets("Bグループ企業").Select
  End If

  If Cells(i, 5) = "○"
  Worksheets("Cグループ企業").Select
  End If

  Set SearchArea = ActiveSheet.UsedRange
  
  Set FoundCell = SearchArea.Find(what:=Target, LookIn:=xlValues, _
          LookAt:=xlPart, MatchCase:=False, MatchByte:=False)
  If FoundCell Is Nothing Then Exit Sub
  Addr = FoundCell.Address
  
  Do
    ReDim Preserve FoundAddr(i) '配列の内容を維持したまま再宣言
    FoundAddr(i) = FoundCell.Address '検索結果のアドレスを配列に格納
    Set FoundCell = SearchArea.FindNext(After:=FoundCell)
    i = i + 1
    If FoundCell Is Nothing Then Exit Do
  Loop Until FoundCell.Address = Addr
  
  '配列に格納されたアドレスをカンマ区切りで結合し、セル範囲を一括選択
  Range(Join(FoundAddr, ",")).Select  '---(1)
End Sub
  

【76662】Re:条件別で選択するシートを変え、シー...
発言  kanabun  - 15/2/24(火) 17:37 -

引用なし
パスワード
   ▼さとちぃ さん:
[会社情報一覧]シート
  A     B     C       D       E
1 会社名   リンク Aグループ企業  Bグループ企業 Cグループ企業
2 ZF株式会社       ○   
3 XYZ株式会社              ○ 

こちらは たとえば、[会社情報一覧]シートの [A2]セルを選択して マクロ
ボタンを押すと、
2行目の ○ の印の入っている列が C列だから C列の1行目の「Aグループ企業」
という名前のシートのA列から "ZF株式会社" をFind し、色を付ける-----
というマクロを実行する、ということですね?

飛んだ先のシートに 検索word"ZF株式会社" は複数あるのですか?
また、その列はどの列ですか?(全列検索する必要ないですよね?)

【76663】Re:条件別で選択するシートを変え、シー...
発言  kanabun  - 15/2/24(火) 20:06 -

引用なし
パスワード
   飛んだ先のシートのA列に会社名が書いてあるとして、
A列に AutoFilter のコード例です。

Sub 別シートの会社名セルに色を付ける()
  Dim c As Range
  Dim Sheetname As String
  Dim CompanyName As String
  
  'ActiveSheetは 「会社情報一覧」
  If ActiveCell.Column <> 1 Then Exit Sub
  'ActiveCellが A列のときだけ実行する
  
  CompanyName = ActiveCell.Value
  Set c = Cells(ActiveCell.Row, Columns.Count).End(xlToLeft)
  If c.Value <> "○" Then Exit Sub
  Sheetname = Cells(1, c.Column).Value
  '対象シートのA列にフィルタをかける
  With Worksheets(Sheetname).Cells(1).CurrentRegion.Columns(1)
    .AutoFilter 1, CompanyName
    'ヒットした行があれば 色を付ける
    If .SpecialCells(xlVisible).Count > 1 Then
      Intersect(.Cells, .Offset(1)).Interior.Color = vbCyan
    End If
    .AutoFilter
  End With
    
End Sub

【76664】Re:条件別で選択するシートを変え、シー...
質問  さとちぃ  - 15/2/25(水) 10:05 -

引用なし
パスワード
   さとちぃです。
すみません.

ご返信が遅くなりまして申し訳ありませんでした。

ZF株式会社は複数ある場合がありますので、複数箇所色を変える表示が望ましいです。
飛んだ先のシートというのは、イメージとして緊急連絡網のようなものです。そのため、
シートの全領域を検索する形となります。


ABC株式会社―ZF株式会社―123運輸株式会社―BPJAPAN株式会社・・・・

XYZ株式会社―ZF株式会社―PP運輸株式会社―BPUSA株式会社・・・・・・

ですのでシートの全領域をFind検索して、色を付ける形とすれば良いのかと考えているのですが・・・。

こちらの形でも教えていただけるとうれしく存じます。
引き続き、恐縮ですがお願い出来ませんでしょうか?


教えていただいたA列でのオートフィルタを使った表示についても別のところで参考になりまして、ありがとうございました!

【76665】Re:条件別で選択するシートを変え、シー...
発言  kanabun  - 15/2/25(水) 10:36 -

引用なし
パスワード
   ▼さとちぃ さん:

>ZF株式会社は複数ある場合がありますので、複数箇所色を変える表示が望ましいです。

そのばあいは さとちぃさんがやっておられるような Findメソッドの繰り返しと
なります。
(↓こんな感じ: 下のほうを修正)

Sub 別シートの会社名セルに色を付ける2() '列を特定しない
  Dim c As Range
  Dim Sheetname As String
  Dim CompanyName As String
  
  'ActiveSheetは 「会社情報一覧」
  If ActiveCell.Column <> 1 Then Exit Sub
  'ActiveCellが A列のときだけ実行する
  
  CompanyName = ActiveCell.Value
  Set c = Cells(ActiveCell.Row, Columns.Count).End(xlToLeft)
  If c.Value <> "○" Then Exit Sub
  Sheetname = Cells(1, c.Column).Value
  
  '対象シートのA列にフィルタをかける
  Dim r As Range
  Set r = Worksheets(Sheetname).UsedRange
  r.Interior.ColorIndex = xlNone
  Set c = r.Find(CompanyName, , xlValues, xlPart)
  If c Is Nothing Then Exit Sub
  
  Dim Address1 As String
  Address1 = c.Address
  Do
    'ヒットした行があれば 色を付ける
    c.Interior.Color = vbCyan
    Set c = r.FindNext(After:=c)
  Loop Until c.Address = Address1
    
End Sub

【76666】Re:条件別で選択するシートを変え、シー...
発言  kanabun  - 15/2/25(水) 10:38 -

引用なし
パスワード
   失礼。コメントちがい

> 'ヒットした行があれば 色を付ける

正 'ヒットしたセルに 色を付ける

【76667】Re:条件別で選択するシートを変え、シー...
質問  さとちぃ  - 15/2/25(水) 11:23 -

引用なし
パスワード
   KANABUN様

さとちぃです。
早速のご回答ありがとうございました。
いろいろトライしてみたのですが、

Set r = Worksheets(Sheetname).UsedRange

の部分にて、インデックスが有効範囲にありませんという形で
エラーが出ます。

私なりに考えてみたのですが、対象シートの選択の為に
If文による条件設定が必要ではないかと思ったのですが
いかがでしょうか?

つまり、

If C列に○がある場合、WorkSeet("Aグループ企業")を選択
If D列に○がある場合、WorkSeet("Bグループ企業")を選択
If E列に○がある場合、WorkSeet("Cグループ企業")を選択

といった形です。

大変恐れ入りますが、こちらも教えていただけますでしょうか?

【76668】Re:条件別で選択するシートを変え、シー...
発言  kanabun  - 15/2/25(水) 11:42 -

引用なし
パスワード
   ▼さとちぃ さん:

>早速のご回答ありがとうございました。
>いろいろトライしてみたのですが、
>
>Set r = Worksheets(Sheetname).UsedRange
>
>の部分にて、インデックスが有効範囲にありませんという形で
>エラーが出ます。

「インデックスが有効範囲にありません」というエラーは、今回のばあい
Sheetnameの中に入っているシート名が 実際のシート名に無い ことが原因と
考えられます。
Sheetname のなかに C列1行目の "Aグループ企業" が入っているとして、
「Aグループ企業」というシートは実際に存在しますか?

チェックのため、上の1行を複数行に分割して、
Dim r As Range
Dim ws as Worksheet
On Error Resume Next
  Set ws = Worksheets(Sheetname)
On Error Goto 0
If ws Is Nothing Then
  MsgBox Sheetname & " という名前のシートがありません"
  Exit Sub
End If
Set r = ws.UsedRange

としてみてください。


>私なりに考えてみたのですが、対象シートの選択の為に
>If文による条件設定が必要ではないかと思ったのですが
>いかがでしょうか?

元シートの1行目に 検索対象シートのシート名が書いてあるのであれば、
対象シートを Worksheets(Sheetname) で特定できるので、ジャンプしたり
選択したりする必要はありません(ただし、セル塗りつぶしの結果をみたいので
そのシートへジャンプしたいというのであれば、 ws.Activate する必要があり
ます)

【76669】Re:条件別で選択するシートを変え、シー...
お礼  さとちぃ  - 15/2/25(水) 14:23 -

引用なし
パスワード
   KANABUN様

さとちぃです。
無事動きました!
本当にありがとうございました!

先ほどのご質問の件、コードをしっかり理解しないままご質問してしまい申し訳ありませんでした!

【76670】Re:条件別で選択するシートを変え、シー...
質問  さとちぃ  - 15/2/25(水) 15:15 -

引用なし
パスワード
   KANABUN様

さとちぃです。

すみません、解決した途端、さらに欲が出てきてしまい、以下の様な
内容をVBAにやらせようと考えてます。

こちらも教えていただけませんでしょうか?


(1)
リンク先のセルにはあらかじめセルに色が塗ってありまして
教えていただいたプログラムですと、事前にセルに塗っていた
色が白色設定となり、ヒットしたセルのみ色が変わる形に
なっております。

対象のセル以外は、色設定はそのままとするにはどのように
すればいいでしょうか?

(2)

Interior.Color = vbCyan

において、文字の大きさも変えたいのですが、Fontオブジェクトで
設定しようと試みましたが、うまく出来ません・・・。

重ね重ね申し訳ありません。
よろしくお願いします!

【76673】Re:条件別で選択するシートを変え、シー...
発言  kanabun  - 15/2/25(水) 17:00 -

引用なし
パスワード
   ▼さとちぃ さん:

>(1)
>リンク先のセルにはあらかじめセルに色が塗ってありまして
>教えていただいたプログラムですと、事前にセルに塗っていた
>色が白色設定となり、ヒットしたセルのみ色が変わる形に
>なっております。
>
>対象のセル以外は、色設定はそのままとするにはどのように
>すればいいでしょうか?

とりあえず、
>  r.Interior.ColorIndex = xlNone
の行をコメントにしてください。
  'r.Interior.ColorIndex = xlNone


>(2)
>
>Interior.Color = vbCyan
>
>において、文字の大きさも変えたいのですが、Fontオブジェクトで
>設定しようと試みましたが、うまく出来ません・・・。

どう試してみたのかしら?

  Do
    'ヒットしたセルがあれば 色を付け、Fontsizeを変更する
    c.Interior.Color = vbCyan
    c.Font.Size = 18 '←好きなサイズ
   
    Set c = r.FindNext(After:=c)
  Loop Until c.Address = Address1

【76684】Re:条件別で選択するシートを変え、シー...
質問  さとちぃ  - 15/2/26(木) 15:47 -

引用なし
パスワード
   ▼kanabun さん:
>▼さとちぃ さん:
>
>>(1)
>>リンク先のセルにはあらかじめセルに色が塗ってありまして
>>教えていただいたプログラムですと、事前にセルに塗っていた
>>色が白色設定となり、ヒットしたセルのみ色が変わる形に
>>なっております。
>>
>>対象のセル以外は、色設定はそのままとするにはどのように
>>すればいいでしょうか?
>
>とりあえず、
>>  r.Interior.ColorIndex = xlNone
>の行をコメントにしてください。
>  'r.Interior.ColorIndex = xlNone
>
>
>>(2)
>>
>>Interior.Color = vbCyan
>>
>>において、文字の大きさも変えたいのですが、Fontオブジェクトで
>>設定しようと試みましたが、うまく出来ません・・・。
>
>どう試してみたのかしら?
>
>  Do
>    'ヒットしたセルがあれば 色を付け、Fontsizeを変更する
>    c.Interior.Color = vbCyan
>    c.Font.Size = 18 '←好きなサイズ
>   
>    Set c = r.FindNext(After:=c)
>  Loop Until c.Address = Address1

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