こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

マウスで指定した、2つのExcelBookのSheet内の任意の範囲のアドレスを取得するマクロは?

Excelの2つのファイルを開いた状態で、それぞれのシートの複数のセルをマウスで範囲指定して、そのファイル名、Sheet名、セル範囲を使って重複や検索、書き換えに関するマクロを作成しています。
一つのシート内ですと、
Set 選択範囲1 = Application.InputBox("範囲?", Type:=8)
で、うまくできるのですが、シートが2枚の間では、はじめのシートで処理されてしまいます。
複数のシート、出来れば、2つのブック間で処理したいのですがどなたかお教えください。

投稿日時 - 2007-07-30 16:37:53

QNo.3212526

すぐに回答ほしいです

質問者が選んだベストアンサー

ぁ、ごめんなさい。もうひとつ。

If 値1 <> "" Then
この判定は中の 選択範囲2 のLoopの外に出して、1回だけの判定で良いですね。
その方が、値1 = ""の時、無駄なLoop処理をしないで済みます。

For Each r1 In 選択範囲1
  値1 = r1.Value

  If 値1 <> "" Then
    
    For Each r2 In 選択範囲2
      値2 = r2.Value
      If 値1 = 値2 Then
        色1 = r1.Interior.ColorIndex
        Select Case 色1

          '(略)

        End Select
        r1.Interior.ColorIndex = 色
        r2.Interior.ColorIndex = 色
      End If
    Next r2

  End If

Next r1

投稿日時 - 2007-07-31 21:21:49

お礼

完璧なアドバイス、ありがとうございました。
For Each r1 In 選択範囲1 や Rangeの各要素の使用方法について学習してゆきたいと思います。
また、これをもとに、思案中のマクロを完成させることが出来そうです。
迅速に対応していただき、本当にありがとうございました。

投稿日時 - 2007-08-01 10:07:37

ANo.4

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(4)

ANo.3

>お恥ずかしいのですが、
恥ずかしがらなくてもよいと思いますよ。
現状を示して頂いたほうが、色々なアドバイスを受ける事ができて、
早く上達するのではないでしょうか。

Sub sample1()
  Const msg As String = "データの連続した範囲をマウスで指定し、「OK」を押してください。"
  Dim 選択範囲1 As Range
  Dim 選択範囲2 As Range
  Dim 値1    As Variant
  Dim 値2    As Variant
  Dim 色1    As Long
  Dim 色    As Long
  Dim r1    As Range
  Dim r2    As Range

  On Error GoTo myError
  Set 選択範囲1 = Application.InputBox("元になる" & msg, Type:=8)
  選択範囲1.Interior.ColorIndex = xlNone  '-4142  '塗りつぶし無しに設定
  Set 選択範囲2 = Application.InputBox("比較する" & msg, Type:=8)
  選択範囲2.Interior.ColorIndex = xlNone  '-4142  '塗りつぶし無しに設定
  
  For Each r1 In 選択範囲1
    値1 = r1.Value
    
    For Each r2 In 選択範囲2
      値2 = r2.Value
      If 値1 <> "" Then
        If 値1 = 値2 Then
          色1 = r1.Interior.ColorIndex
          Select Case 色1
            Case xlNone: 色 = 33
            Case 33:   色 = 41
            Case 41:   色 = 5
            Case 5:   色 = 6
            Case 6:   色 = 43
            Case 43:   色 = 12
            Case 12:   色 = 38
            Case 38:   色 = 7
            Case 7:   色 = 3
            Case 3:   色 = 9
            Case Else:  色 = 10
          End Select
          r1.Interior.ColorIndex = 色
          r2.Interior.ColorIndex = 色
        End If
      End If
    Next r2
  
  Next r1
  
  Exit Sub
myError:
  Select Case Err.Number
    Case 424  'キャンセル
      MsgBox "  キャンセルされました。  "
      End
    Case Else
      MsgBox "  予期せぬエラーが発生しました。  エラーコード" & Err.Number
  End Select
End Sub

まず、For Each...Next ステートメントについて調べてみてください。
For Each r1 In 選択範囲1...で 選択範囲1で格納した Range の各要素をLoopします。
Loop範囲を決める行位置や列位置を調べなくても済みます。

また、先ほど書いたように
Cells(行1, 列1)
という記述は、ActiveSheetのCellsの 行1, 列1 を指定することになります。
For Each...Next ステートメントを使う事で、
Loop要素 r1 や r2 は 指定した範囲の各セルをダイレクトに指定するわけですから、
この指定も不要になります。
選択範囲1 や 選択範囲2 はBookやSheetも含めたRangeオブジェクトを取得していますから
こちらのほうが都合いいわけです。

また
>Range(選択範囲1.Address).Select
>Selection.Interior.ColorIndex = -4142
このようにSelectしなくても
選択範囲1.Interior.ColorIndex = -4142
と記述できます。
そのほうが不測のエラーを防げますし、実行速度にも影響してきます。
以上、参考にしてみてください。

投稿日時 - 2007-07-31 17:36:10

ANo.2

別Bookの選択について書きます。
(別シートは、そのシートを選択するだけですので問題ないと思えるのですが?)
ユーザーに選択してもらうなら、
メニュー[ウィンドウ]から切り替えてもらえばいいです。
VBAコード内で切り替えてあげるなら、先にも書きましたが
ActiveWindow.ActivateNext
もしくはBook名がわかっているなら
Workbooks("Book1.xls").Activate
などとします。



ですが、問題は別のところにあるのでしょう。

値1 = Cells(行1, 列1).Value

この Cells(行1, 列1) はActiveSheetを指しますが、それで良いのでしょうか?
取得したRangeの『選択範囲1』の(行1, 列1)なら 選択範囲1(行1, 列1) もしくは
選択範囲1.Cells(行1, 列1) や 選択範囲1.Item(行1, 列1) などとします。

詳細がわかりませんので、あまり適確なアドバイスでなかったらごめんなさい。
もし追加で説明が必要であれば、マクロの全文を提示してもらったほうがアドバイスし易いのですが。

投稿日時 - 2007-07-31 11:21:13

補足

お恥ずかしいのですが、マクロ全文です。
アドバイスお願いいたします。
---------------
Sub 比較塗り潰し()
On Error GoTo myError

Dim 選択範囲1 As Range
Dim 選択範囲2 As Range

Set 選択範囲1 = Application.InputBox("元になるデータの連続した範囲をマウスで指定し、「OK」を押してください。", Type:=8)
Range(選択範囲1.Address).Select
Selection.Interior.ColorIndex = -4142 '塗りつぶし無しに設定
左1 = Selection.Column '選択された範囲の左端
上1 = Selection.Row '   〃    上端
右1 = 左1 + Selection.Columns.Count - 1 '   〃    右端
下1 = 上1 + Selection.Rows.Count - 1 '   〃    下端

Set 選択範囲2 = Application.InputBox("比較するデータの連続した範囲をマウスで指定し、「OK」を押してください。", Type:=8)
Range(選択範囲2.Address).Select
Selection.Interior.ColorIndex = -4142 '塗りつぶし無しに設定
左2 = Selection.Column '選択された範囲の左端
上2 = Selection.Row '   〃    上端
右2 = 左2 + Selection.Columns.Count - 1 '   〃    右端
下2 = 上2 + Selection.Rows.Count - 1 '   〃    下端

For 列1 = 左1 To 右1
For 行1 = 上1 To 下1
値1 = Cells(行1, 列1).Value

For 列2 = 左2 To 右2
For 行2 = 上2 To 下2
値2 = Cells(行2, 列2).Value
If 値1 = 値2 Then
If 値1 <> "" Then
色1 = Cells(行1, 列1).Interior.ColorIndex
Select Case 色1
Case -4142
色 = 33
Case 33
色 = 41
Case 41
色 = 5
Case 5
色 = 6
Case 6
色 = 43
Case 43
色 = 12
Case 12
色 = 38
Case 38
色 = 7
Case 7
色 = 3
Case 3
色 = 9
Case Else
色 = 10
End Select
Cells(行1, 列1).Select
Selection.Interior.ColorIndex = 色
Cells(行2, 列2).Select
Selection.Interior.ColorIndex = 色

End If
End If
Next 行2
Next 列2

Next 行1
Next 列1
End
myError:
Select Case Err
Case 424 'キャンセル
MsgBox "  キャンセルされました。  "
End
Case Else
MsgBox "  予期せぬエラーが発生しました。  エラーコード" & Err
End Select
End Sub

投稿日時 - 2007-07-31 15:49:24

ANo.1

こんにちは。
選択がRange型で取得できていれば
そのRangeはBook,Sheet固有のものですから、問題ないと思うのですが。

Sub test()
  Dim r1 As Range
  Dim r2 As Range

  With Application
    Set r1 = .InputBox("r1", Type:=8)
    Set r2 = .InputBox("r2", Type:=8)
  End With
  MsgBox r1.Address(external:=True) & vbLf _
     & r2.Address(external:=True)
  Set r1 = Nothing
  Set r2 = Nothing
End Sub

この後Range型変数をどのように使っているか、によるかもしれませんね。

それとも、もしかしたら.InputBoxメソッド時に他Bookを参照できないという意味でしょうか?
その場合は、間に
ActiveWindow.ActivateNext
を入れて対応したり、
またはメニュー[ウィンドウ]から切り替えてもらったり、などで対応できませんか?

ご質問の意味をかん違いしていたら、補足お願いします。

投稿日時 - 2007-07-30 22:03:31

補足

早速のご回答に感謝いたします。

>>この後Range型変数をどのように使っているか、によるかもしれませんね。

ご指摘の通り、かもしれません。

この後は、
範囲の行数と列数をFor,next文を使って
値1 = Cells(行1, 列1).Value
に代入して比較しています。

2つのシート間を移動しますので、ブックやシートのアクティブが必要なのですね?
もし、そうでしたら、方法をお教えください。
幼稚なマクロで申し訳ありません。

投稿日時 - 2007-07-31 09:25:24

あなたにオススメの質問