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

質問

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

回答No.4

pauNed · ベストアンサー

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

If 値1 <> "" Then
この判定は中の 選択範囲2 のLoopの外に出して、１回だけの判定で良いですね。
その方が、値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

お礼

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

回答No.3

pauNed

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

Sub sample1()
　　Const msg As String = "データの連続した範囲をマウスで指定し、「ＯＫ」を押してください。"
　　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
と記述できます。
そのほうが不測のエラーを防げますし、実行速度にも影響してきます。
以上、参考にしてみてください。

回答No.2

pauNed

別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) などとします。

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

補足

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

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

Set 選択範囲1 = Application.InputBox("元になるデータの連続した範囲をマウスで指定し、「ＯＫ」を押してください。", 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("比較するデータの連続した範囲をマウスで指定し、「ＯＫ」を押してください。", 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

回答No.1

pauNed

こんにちは。
選択が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
を入れて対応したり、
またはメニュー[ウィンドウ]から切り替えてもらったり、などで対応できませんか？

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

補足

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

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

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

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

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