Ｅｘｃｅｌマクロ（Range）について

質問

Sheet1のA1:Q100を"東京"という名前で定義しています。
Sheet2のA1:Q100を"沖縄"という名前で定義しています。
Sheet3のA1:Q100を"北海道"という名前で定義しています。
Sheet4のA1:Q100を"宮崎"という名前で定義しています。
Sheet5は検索シートとしています。
検索のマクロを考えていて、どうしても分からないのが『Range』の使い方です。
検索をする範囲はSheet1～4のA1:Q100です。
Range("東京")　として、１つの範囲ならできるのですが、"東京"、"沖縄"、"北海道"、"宮崎"の４つから検索するにはどうしたらよいのでしょうか？ただ単に
Range（"東京"、"沖縄"、"北海道"、"宮崎"）　ではだめですよね。

回答No.9

Wendy02 · ベストアンサー

こんにちは。

>「抽出した範囲にはフィールド名がないか、または無効なフィールド名です」

その意味は分かっていますが、それを、マクロのほうの問題に振られてしまうのは、かなり厳しいです。本当は、フィールド行を丁寧に調べていただければよいと思います。あまり大きなクライテリアのようですから、どこかにミスがあるように思います。

端的にいうと、CriteriaRange（条件式）の　"A2:Q3"　と、実際のデータの上のフィールド行の名前と食い違っているからです。

細かい部分でも違っていると、エラーが出てくることがありますから、以下のマクロで、内容を調べてみてください。間違った部分が指摘されるはずです。

'---------------------------------------
Sub TestCriteria()
　　Dim sh As Variant
　　Dim rng As Range
　　Dim i As Integer
　　Dim j As Integer
　　Dim k As Integer
　　'クライテリアレンジの場所
　　Const CRRNG As String = "A2:Q3"
　　'フィールド名の行の位置
　　Const FROW As Integer = 1

　　Set rng = Worksheets("Sheet5").Range(CRRNG)

　　For Each sh In Array(Worksheets("Sheet1"), Worksheets("Sheet2"), Worksheets("Sheet3"), Worksheets("Sheet4"))
　　　　On Error Resume Next
　　　　For i = 1 To rng.Columns.Count
　　　　　　If sh.Cells(FROW, i).Value <> rng.Cells(FROW, i).Value Then
　　　　　　　　j = j + 1
　　　　　　　　Application.Goto sh.Cells(FROW, i)
　　　　　　　　If MsgBox(sh.Name & "!" & sh.Cells(FROW, i).Address & " が違っています。" & sh.Cells(1, i).Value & vbCrLf & _
　　　　　　　　　　"修正しますか？", vbOKCancel) = vbCancel Then
　　　　　　　　　　GoTo EndLine
　　　　　　　　Else
　　　　　　　　　 sh.Cells(FROW, i).Value = rng.Cells(FROW, i).Value
　　　　　　　　　 k = k + 1
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　　　On Error GoTo 0
　　Next sh
　　If j = 0 Then
　　　 MsgBox "正常に終了しました。", 64
　　Else
　　　 MsgBox k & " 個修正しました。" & vbCrLf & _
　　　 "念のためにもう一度、このマクロを実行してください。", 48
　　End If
　　Exit Sub
EndLine:
　　　MsgBox ActiveCell.Address & " に問題があります。", 48

End Sub

回答No.10

Wendy02

#9 にちょっと加えておくと、本来、#9 のマクロを使う必要はありません。

こんなに構造的に単純で簡単なマクロは、本来、手動で出来るという条件でもって、その方法（マクロの手法のひとつ）に臨むわけで、それをマクロのコードの問題に振られると、かなり面倒な内容になってくるのです。ユーザーのエラーに対する予想できるエラー修正を施すというのは、掲示板の領域の問題ではなくなってしまいます。

今回は、フィールド行とクライテリアの項目の一行目とが一致していないということです。

マクロを動かす前に、「シートのデータを良く調べてください」というしか、本来はできないのです。それだけは、分かってください。もう一つの方のマクロでも、同じ条件だと思います。エラーのメッセージで、ワークシートから返るものは、ほとんどは、マクロ側での処理は不可能です。

回答No.8

Wendy02

#5 の回答者です。

>リストがありません。というエラーがでてしまいました。

あまり、私は深く追求するつもりはありませんが、それは、.

"東京"、"沖縄"、"北海道"、"宮崎"
>Array(Range("東京"), Range("沖縄"), Range("北海道"), Range("宮崎"))

の名前の範囲の親オブジェクトが正しく取れていないか、リストとして取れないということだと思います。だから、Range(名前定義) 型は、実際には、難しいというべきかもしれませんが、こちらでは、コード自体の問題とはも思えませんので、それ自体は難しいです。

[名前定義]というのは、親オブジェクトがシート型とApplication型と二つあります。

>Sheet1のA1:Q100を"東京"という名前で定義しています。

あえて、[名前定義]で書いたことに、私の意味があるので、A1:Q100ということで換えるなら、最初の方と同じ内容になってしまいますので、こちらとしては、これきりにします。

'標準モジュール
-----------------------------------------------------
Sub PickUpThruSheetsR()
　　Dim rng As Range
　　Dim cRng As Range
　　Dim sh As Variant
　　With Worksheets("Sheet5")
　　.Select
　　Application.ScreenUpdating = False
　　.Range("A10:Q10000").ClearContents
　　For Each sh In Array(Worksheets("Sheet1"), Worksheets("Sheet2"), Worksheets("Sheet3"), Worksheets("Sheet4"))
　　　　Set cRng = .Range("A65536").End(xlUp).Offset(1)
　　　　If cRng.Row < 10 Then
　　　　　　Set cRng = .Range("A10")
　　　　End If
　　　　sh.Range("A1:Q100").AdvancedFilter _
　　　　Action:=xlFilterCopy, _
　　　　CriteriaRange:=.Range("A2:Q3"), _
　　　　CopyToRange:=cRng, _
　　　　Unique:=False
　　　　'タイトル行を消す
　　　　'cRng.Resize(, 17).Clear
　　　　'シート名を付ける
　　　　'cRng.Value = sh.Name
　　Next sh
　　End With
　　Application.ScreenUpdating = True
End Sub

補足

上記のマクロに書き換えてみたところ、前回と同じエラーがおきてしまいました。sh.Range("A1:Q100").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("A2:Q3"), _
CopyToRange:=cRng, _
Unique:=False
をどう変えたらよいでしょうか。

回答No.7

hana-hana3

＞すみません、どこに入れ込めばいいでしょうか？

入れ込むのではなく、同じコードが書かれた所を置き換えるだけです。
コードの Rows を Row にするだけですから、入替えなくても [s] を削除すればＯＫです。

補足

”抽出した範囲にはフィールド名がないか、または無効なフィールド名です”というエラーがおきてしまいました。デバックをすると『.Range("A1:Q100").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A2:Q3"), _
CopyToRange:=Sheets("Sheet5").Range(Top), Unique:=False』が反転されます。

回答No.6

hana-hana3

＞型が一致しません。

ちょっとミスしました。

Rows ではなく、Row に修正して
下記のようして下さい。

If Sheets("Sheet5").Range("A65536").End(xlUp).Row < 10 Then
Top = "A10"
Else
Top = "A" & Sheets("Sheet5").Range("A65536").End(xlUp).Row + 1
End If

補足

すみません、どこに入れ込めばいいでしょうか？

回答No.5

Wendy02

こんにちは。

ちょっと割り込みさせていただきます。あまり、難しい方法は考えておりませんが、以下のような方法で可能だと思います。

ただ、マクロで、[名前定義]登録を使うのは、あまり関心しませんが、マクロで名前定義を書き換えたりしなければ、良いかもしれません。特殊なエラーが発生したことがあります。

'これは、標準モジュールに書き込みのがベストです。

Sub PickUpThruSheets()
　　Dim rng As Range
　　Dim cRng As Range
　　Dim r As Variant
　　With Worksheets("Sheet5")
　　.Select
　　Application.ScreenUpdating = False
　　.Range("A10:Q10000").ClearContents
　　For Each r In Array(Range("東京"), Range("沖縄"), Range("北海道"), Range("宮崎"))
　　　　Set cRng = .Range("A65536").End(xlUp).Offset(1)
　　　　If cRng.Row < 10 Then
　　　　　　Set cRng = .Range("A10")
　　　　End If
　　　　r.AdvancedFilter _
　　　　Action:=xlFilterCopy, _
　　　　CriteriaRange:=.Range("A2:Q3"), _
　　　　CopyToRange:=cRng, _
　　　　Unique:=False
　　　　'タイトル行を消す
　　　　'cRng.Resize(, 17).ClearContents
　　　　'シート名を付ける
　　　　'cRng.Value = r.Parent.Name
　　Next r
　　End With
　　Application.ScreenUpdating = True
End Sub

補足

r.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.Range("A2:Q3"), _
CopyToRange:=cRng, _
Unique:=False
が黄色反転になり、リストがありません。というエラーがでてしまいました。

回答No.4

hana-hana3

範囲名だけで行う事は不可能なので、こんな感じになります。
動作確認はしていません。

Sub 検索2()

Dim WsAry As Variant
Dim i As Integer
Dim Top As String

'フィルタリングするシート名
WsAry = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
'集計シートクリア
Sheets("Sheet5").Range("A10:IV10000").Clear

For i = LBound(WsAry) To UBound(WsAry)
'集計シートの転記先を設定
If Sheets("Sheet5").Range("A65536").End(xlUp).Rows < 10 Then
Top = "A10"
Else
Top = "A" & Sheets("Sheet5").Range("A65536").End(xlUp).Rows + 1
End If
'フィルタ
With Sheets(WsAry(i))
.Range("A1:Q100").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range("A2:Q3"), _
CopyToRange:=Sheets("Sheet5").Range(Top), Unique:=False
End With
Next

End Sub

補足

Top = "A" & Sheets("Sheet5").Range("A65536").End(xlUp).Rows + 1
型が一致しません。
とでてしまいました。

回答No.3

hana-hana3

＞このようなマクロなんですが、どこにどう入れたらいいのでしょうか？

検索ではなくフィルタだったんですね。
４つのシートのフィルタ結果をシート５に集める（一覧）ということでしょうか？

補足

説明不足ですみませんでした。
４つのシートのフィルタ結果をシート５に集める（一覧）ということです。

回答No.2

hana-hana3

＞異なるシートであれば指定できますか？

異なるシートのセル（範囲）を混合して指定する事はできません。
異なるシートのセル（範囲）を指定する場合は、シートとセル（範囲）をセットで指定しないと利用できません。

あとは、作業グループにしてしまう事です。
Sheets("Sheet1","Sheet2","Sheet3","Sheet4").Range("A1:Q100").Find()

補足

Sub 検索()

Rows("10:10000").Select
Selection.Delete Shift:=xlUp
Range("A10").Select
Range("東京").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("A2:Q3"), CopyToRange:=Range("A10"), Unique:=False
End Sub
このようなマクロなんですが、どこにどう入れたらいいのでしょうか？

回答No.1

hana-hana3

異なるシートのセルを一緒に指定する事はできません。
シートを指定しながら検索するしか方法はありません。

Dim i As Integer
Dim findcell As Range

For i = 1 To 4
With Sheets(i)
set findcell= .Range("A1:Q100").Find()

End With
Next

補足

マクロ初心者なもので・・・初歩的な質問なんですが、
>異なるシートのセルを一緒に指定する事はできません。

異なるシートであれば指定できますか？