[[20210321000422]]　『アプリケーション定義またはオブジェクト定義のエ』（素人）　ページの最後に飛ぶ

『アプリケーション定義またはオブジェクト定義のエラーです』（素人）

いつもお世話になっております。
下記コードがエラーになります。原因を教えてください。
やはりRange("key:Rng")が原因でしょうか？
単一のrangeの変数同士の範囲はどのようにしたらいいでしょうか？
また他にもエラーになっていると思いますのでご教授お願いします。
＊内容は列でA１のキーワード検索後　そのキーワードから上方向へ
食前などの検索を行ってその範囲を左に４倍してコピーしようと思います。
同じ列に食前　食後などがいくつかありますが、キーワードに一番近い
ものとの範囲だけを取り出したいです。

Sub kensaku()
Dim I As Long, key As Range, Rng As Range

Sheets("各自一覧").Range("B:N").Delete
For I = 1 To Worksheets.Count
If Worksheets(I).name <> "各自一覧" Then

With Worksheets(I)
Set key = .Range("B1:B100").Find(What:=Sheets("各自一覧").Range("A1").Value, lookat:=xlPart)
If Not key Is Nothing Then
Set Rng = .Cells.Find(What:="食前", after:=key, lookat:=xlPart, SearchDirection:=xlPrevious)
.Range("key:Rng").Resize(0, 4).Copy
ElseIf Rng Is Nothing Then
Set Rng = .Cells.Find(What:="食後", after:=key, lookat:=xlPart, SearchDirection:=xlPrevious)
.Range("key:Rng").Resize(0, 4).Copy
ElseIf Rng Is Nothing Then
Set Rng = .Cells.Find(What:="寝る前", after:=key, lookat:=xlPart, SearchDirection:=xlPrevious)
.Range("key:Rng").Resize(0, 4).Copy
ElseIf Rng Is Nothing Then
Set Rng = .Cells.Find(What:="その他", after:=key, lookat:=xlPart, SearchDirection:=xlPrevious)
.Range("key:Rng").Resize(0, 4).Copy
ElseIf Not Rng Is Nothing Then

 Sheets("各自一覧").Cells(Rows.Count, 2).End(xlUp).Offset(4).PasteSpecial xlPasteAll
end if
end with
end if
next
end sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

まずは落ち着いて↓を読んでみてください。
[[20210318223052]]　『オブジェクト変数または With ブロック変数が設定』（初心者）

そして、ステップ実行して思い通りに動いてない部分がないかチェックしてください。

さらに、タイプミスがあってもつまらないでしょうから、できればVBEのコードをそのまま貼ってください。
（すくなくとも、最後の方手打ちですよね？）

（もこな２） 2021/03/21(日) 01:06

追加で。

＞下記コードがエラーになります。原因を教えてください。
どこの部分で、なんというエラー（エラー番号、エラーメッセージ）になるのですか？

＞やはりRange("key:Rng")が原因でしょうか？
そのような名前を付けたセルがなければ、そうでしょうね。

＞内容は列でA１のキーワード検索後

 Worksheets(I).Cells.Find

ですから、特定の列ではなく全セルが対象になってますよ。

＞単一のrangeの変数同士の範囲
ちょっと言ってる意味がわかりません。例をあげてみてもらえませんか？

＞同じ列に食前　食後などがいくつかありますが、キーワードに一番近いものとの範囲だけを取り出したいです。
こちらは、おそらく下から探して最初にヒットしたセルのことを言ってると思いますが、下から探す以上「寝る前」→「その他」→「食後」→「その他」→「食前」という順番で探さないとダメじゃないです？（それでも毎食飲むやつは対応できないとおもいますが）

無理にとはいいませんが、10行くらいのサンプルデータと、それがどうなれば（なんという結果がとりだせれば）正解なのか提示してもらえませんか？

余談ですが、各自一覧に貼付したところでどこから持ってきたのか、シート名も出力するようにしないとわからなくなりませんか？

（もこな２） 2021/03/21(日) 02:00

もこな２様　返信ありがとうございます。前回の質問のご解答もありがとうございました。
解決したと思って最後まで見ていませんでした。失礼じました。
作っていただいたコードの方がすっきりしていてとてもよかったです。
上記のコードは一部ネットからコピーしたものが混ざっているのでFINDの検索範囲をcellsのままになっていました。
前回のコードを利用させていただき、質問を再度整理します。
Aの列以外に部屋名が凡そ４－８行おきに入っています。まずA1の部屋名と同じセルを検索して
検索して見つけた部屋名が入ったセルから今度同じ列で↑に検索を掛けて”食前、食後、寝る前、その他の文字を含むセルを検索して部屋名とその見つけたセルとの間のセルを横に４倍してコピーを各自一覧に貼り付けていきたいです。
例

　　　　　　　　　　　Ｂ１行目　　食前　　　Ｇ１行目　　　　　～　　　　Ｎ１行目
　　　　　　　　　　　Ｂ２　　　　　　　　　Ｇ２　　　食後　　　　　　　Ｎ４行目　寝る前
　　　　　　　　　　　Ｂ３　　　　　　　　　Ｇ３
　　　　　　　　　　　Ｂ４行目　　部屋名　　・　　　　　　　　　　　　　Ｎ７行目　部屋名
　　　　　　　　　　　　　　　　　　　　　　・
　　　　　　　　　　　　　　　　　　　　　　Ｇ８行目　部屋名　　という感じになっているシート
の食前～部屋名もしくは食後～部屋名などの間のセルを選んでそのとなり４行ずつ（部屋名の行を含む）に部屋ごとのデータが入っているのでそれごと各自一覧のセルに貼り付けていく

各自一覧のシート
Ａ１行目　１００号室　　　　Ｂ３行目以降に　上記のコピーを貼り付けていく

前回のコードの場合　違う部屋のデータが混ざってしまい、見づらかったので。
宜しくお願い致します。

Sub kensaku_を整理2()

      Dim I As Long, key As Range, 列 As Long
      Stop 'ブレークポイントの代わり
      With Sheets("各自一覧")
         .Range("B3").CurrentRegion.Delete
         On Error Resume Next
         For I = 1 To Worksheets.Count
            If Worksheets(I).Name <> .Name Then
               For 列 = 2 To 14 Step 4
                  Set key = Intersect(Worksheets(I).Rows("1:100"), Worksheets(I).Columns(列)).Find(what:=.Range("A1").Value, LookIn:=xlValues, lookat:=xlPart)
                  key.Offset(-8, 0).Resize(11, 4).Copy .Cells(Rows.Count, 列).End(xlUp).Offset(2)
               Next 列
            End If
         Next I
         On Error GoTo 0
      End With
   End Sub
（素人） 2021/03/22(月) 07:45

こういう感じでしょうか？
例
key の検索 B1:B100

B80でヒット

B80から上方向に、食前、食後、寝る前、その他　を検索

四つの検索の内、B80に一番近い位置でヒットしたセル～B80を
右方向に4拡張した範囲をコピー

だとしたら、四つのキーワードをすべて検索する必要があります。

「食前」でヒットしたセルよりも、「寝る前」でヒットしたセルの方がB80に
近い可能性もあるので。

「食前」を検索(ヒットしたら行番号を変数に格納)
「食後」を検索」(ヒットしたら行番号を変数に格納)
「寝る前」を検索(ヒットしたら行番号を変数に格納)
「その他」を検索(ヒットしたら行番号を変数に格納)

（カイル） 2021/03/22(月) 14:40

検索のサンプルはこんな感じになります。
b1:b100の検索一回だけです。
★の箇所で、結果をイミディエイトウィンドウに
出力します。
検索対象のシートを選択して実行してください。
他シートループはしません。

Sub テスト()
Dim key As Range, Rng As Range
Dim myRow() As Long
Dim j As Long
Dim ary: ary = Array("食前", "食後", "寝る前", "その他")
ReDim myRow(3)
Set key = Range("b1:b100").Find( _

    what:=Worksheets("各自一覧").Range("a1").Value, _
     LookIn:=xlValues, lookat:=xlPart)
    If Not key Is Nothing Then
    Debug.Print "key:" & key.Address '★
    For j = LBound(ary) To UBound(ary)
        Set Rng = Range("b1", key).Find(what:=ary(j), _
        after:=key, searchdirection:=xlPrevious)
           If Not Rng Is Nothing Then
            myRow(j) = Rng.Row
            Debug.Print ary(j) & "_" & myRow(j) '★
        End If
    Next j
    End If
 Debug.Print "直近：" & Application.Max(myRow) '★
 ReDim myRow(3)
End Sub

（カイル） 2021/03/22(月) 15:28

 >やはりRange("key:Rng")が原因でしょうか？
 そうですね。
 お使いのバージョンでは 「key」という列番号も 「Rng」という列番号も存在します。
 故に、意図しない範囲になっています。

 >単一のrangeの変数同士の範囲はどのようにしたらいいでしょうか？
 Range(key, Rng) でしょうか。

（チオチモリン） 2021/03/22(月) 17:52

皆様　返信ありがとうございます。
カイル様の配列は配列の勉強がさわり程度しかできていない私には内容がはっきりとは理解ができませんでしたが、keyとRngの検索検結果の行番号から目的の範囲を参照できたので問題が解決できそうです。
大変勉強になりました。ありがとうございました。
（素人） 2021/03/23(火) 03:54

コメント返信：

[ 一覧(最新更新順) ]

[[20210321000422]] 『アプリケーション定義またはオブジェクト定義のエ』（素人） ページの最後に飛ぶ

[[20210321000422]]　『アプリケーション定義またはオブジェクト定義のエ』（素人）　ページの最後に飛ぶ