Excel VBA ～Findで探して貼り付けたいのですが…

Question

、
worksheet”登録"
|8月|列2|Co2排出量|19.95|　消費電力|38.52|TOTAL|55.83|　
|:--|:--:|--:|
||||

worksheet”年度別排出量”
|2020年|４月|５月|６月|７月|8月
|:--|:--:|--:|
|使用時間(h)|150.17 |86.21|96.42|53.4||

上の登録シートのTOTAL値55.83をコピーし、下の年度別排出シートの8月に貼り付けたいのですが
行き詰ってしまったためご教授いただけましたら幸いです。

Sub yotei()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    
    Dim Lastrow As Integer
    Dim kensaku As Range
    Dim myrange As Range
    
    
    Worksheets("登録").Activate
    Set ws1 = Worksheets("年度別排出量")
    Set ws2 = Worksheets("登録")
 
  
    Lastrow = ws1.Range("a1").End(xlToRight).Column 'A列の最終列を取得
    ws2.Range("a4").Activate 'a4セルをアクティブに
   
   
    
    Set myrange = ws1.Range("A1:a" & Lastrow)  'A1:Aセルの最終列を取得
    Set kensaku = myrange.Find(what:=ActiveCell, lookat:=xlPart)  'Find関数でActivecellと同じ値がmyrangeにあるか探してkensakuに代入
    
    ActiveCell.Offset(0, 7).Copy
    kensaku.Offset(1, 1).PasteSpecial＊ここでエラーが出てしまいます。(コード９１）
    
    'End If
        
        
    'Loop
End Sub

色々ネットで探しまくったのですがなぜエラーになるのかも解らず困っております。
よろしくお願いいたします。

Answer 1

http://officetanaka.net/excel/vba/error/execution_error/error_91.htm

エラーが出たときは、コード番号やエラーメッセージそのもので検索してみてください。
たいていの場合、同じように困って質問している人がいるので、原因や解決策が見つかります。
今回の件の場合、
エラーが出て、デバッグのボタンでVBEの画面に戻ったときに、
ローカルウィンドウで変数の中身を確認してみてください。

変数「kensaku」の中身がNothingになってませんか？
検索した文字列と見つかってほしい文字列とが、
全角半角の違いとか
見えない文字(スペースやセル内改行等）がくっついてるとかで、見つかってないかもです。
手動の検索で見つかるかどうか試してみてください。
Findメソッドはその操作を呼び出しているだけなので挙動はほぼ同じです。
また、Findメソッドは、手動でのオプションの変更も引き継ぎますので、
たくさんの設定の記述を省略することは、誤動作の原因になります。
（期待した結果を返したり返さなかったり動作が不安定になる可能性があります。）
なので、マクロの記録で得られたコードをそのまま使用することをお勧めします。
絶対大丈夫だという自信があれば省略してもいいですが。

同じようにActiveCellも、コロコロ変わるものなので、
できれば使わないようにした方が安全です。
直前でアクティブにしているので、間違いはないかと思いますが、
ちょっと怖いです。

僕なら以下のようにします。

Sub 予定転記2()
    Dim rngFrom As Range
    Dim rngTo As Range
    Dim ixCol As Variant
    
    With Worksheets("登録").UsedRange
        Set rngFrom = .Rows(.Rows.Count)
    End With
    Set rngTo = Worksheets("年度別排出量").Rows(1)
    
    ixCol = Application.Match(rngFrom.Cells(1).Value, rngTo, 0)
    
    If Not IsError(ixCol) Then
        rngTo(2, ixCol).Value = rngFrom.Cells(rngFrom.Cells.Count).Value
    Else
        MsgBox "転記先の書き込む項目が見つかりませんでした。"
    End If
End Sub

参考になれば。
動作確認してません。
セルの位置関係や、シートの指定が間違っていたり、
こちらの勘違いで、うまく動かない場合はまた言ってください。
あと、わからないところ、気になるところがあれば聞いてください。
どこが分かってどこが分からないかがこちらではわかりませんので、
説明はとりあえず省略します。

Comments

[masa1975]

ありがとうございます。
ixCol = Application.Match(rngFrom.Cells(1).Value, rngTo, 0)
の場所で : ixCol : エラー 2042 : Variant/Errorと出てしまいます。調べたらN/Aだかららしいのですが
何故でしょう？
ちなみに(登録）のA4セルと同じ値が(年度別排出量）A1の行にあるか探して、あった場合に一つ下の行に
(登録）のH4を貼り付けるといった内容です。forで回した方法をベストアンサーに選ばせていただきましたが、教えて頂いたことは覚えたいので教えて頂けると幸いです。
よろしくお願いいたします。

[mattuwan]

>Application.Match(rngFrom.Cells(1).Value, rngTo, 0)
は、ワークシート上で使うMatch関数をVBAで呼び出しているだけです。
検索値が見つからない場合は、Match関数は＃N/Aを返します。
なぜか？
検索値を間違って指定している。
検索範囲が間違っている。
検索範囲の文字列と検索値の文字列が画面上区別がつかないほど似ているけど、
厳密には違う。

シート上の数式ではうまくできそうですかね？

[masa1975]

コメントありがとうございます。
そういう事なんですね。
確認してみます。
ありがとうございました。

Answer 2

下記のようにされていますが

Lastrow = ws1.Range("a1").End(xlToRight).Column 'A列の最終列を取得

この部分は、A列の最終行ではなく、A１を起点として右に検索しているので
Lastrowは6列目（F）が最大ということを示しています。

また、Set myrange = ws1.Range("A1:a" & Lastrow) 'A1:Aセルの最終列を取得

の部分は、A列の下にむかって処理するとしています。

worksheet”年度別排出量”のデータは縦展開ではなく、横展開なので
A列の最大行を取得したい理由がわかりません・・。

結果、FINDの指定もめちゃくちゃくなりますので、少し情報を整理したほうがよいと思います。

データ数が少ないので、まずは、下記のようにFINDを使わない方法で
データの指定方法について理解をしたほうがFINDで処理できると思います。

参考程度で結構です。。

Sub test()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lastcoumns As String
Dim i As Double
Dim key As String
Dim mymonth As String
Dim mystr As String

Set ws1 = Worksheets("年度別排出量")
Set ws2 = Worksheets("登録")

Lastcoumns = ws1.Range("a1").End(xlToRight).Column

key = ws2.Range("A1").Value
mystr = ws2.Range("H1").Value

For i = 1 To Lastcoumns
    
    mymonth = ws1.Cells(1, i).Value
    
    If mymonth = key Then
        
        ws1.Cells(2, i).Value = mystr
        
        
    End If
Next

Set ws1 = Nothing
Set ws2 = Nothing

End Sub

データ便にUPしておきます。ダウンロード期間は2日間です。
必要であればダウンロードしてください。

https://www.datadeliver.net/receiver/file_box.do?fb=9a132233876d4b4db2693b816cca2ac0&rc=001cb174404346c687b9197920f7c4f7&lang=ja

また、このように、表を縦持ちとして、処理するのが、質問者さんの
FINDでやりたい形式かもしれませんね！

西暦	月	使用時間
2020	1月	XX
2020	2月	XX
2020	3月	XX
2020	4月	XX
2020	5月	XX
2020	6月	XX
2020	7月	XX
2020	8月	55.83

Comments

[masa1975]

ありがとうございます。
勉強不足＆理解不足でやっていたため、頭がゴチャゴチャになっておりました。
教えて頂いた内容、とてもしっくりきました。
ありがとうございました。

[mako1972]

おはようございます。朝早くにレスありがとうございます。

youtube エクセル VBA 62 セル検索爆速選手権（第二回）を参照されるといいでしょうか・・。

https://www.youtube.com/watch?v=zDmpqY24-Ks&t=0s

[masa1975]

おはようございます。参考にさせていただきます。

[mako1972]

変数の宣言がおかしいですね。

Dim Lastcoumns As Stringの部分は

Dim Lastcoumns As doubleとか
Dim Lastcoumns As integerとかでしたね。

[mako1972]

データ便に、表を縦持ちした、FIND例もUPしておきます。
必要であればですけど。ダウンロード期間は１日です
（コードのコメントは少し適当だったようなので無視してください）。

https://www.datadeliver.net/receiver/file_box.do?fb=d84e7830e0234a9eb85ebbe99cb3ff0a&rc=8ffa352c8eae41519c427df57036f6bd&lang=ja

他の方がおっしゃっているとおり、Active、 select、 CopyをVBAで使うと思わぬエラーで
はまることが多いので使わない方法を検討されたほうがよろしいかと思います。

また、データベースとして表を作成する場合は、理由がなければデータは縦に作成したほうが
エクセル関数やマクロとの相性がよいと思います。
理由は列名や列の名称が固定で変わらないためです。

横に検索するのは何か理由があるときのみにしたほうが、混乱を避けられるという意味です。

エラー処理などは入れていませんが・・。少ないコードで検証してほしいという意味で。では。

[mako1972]

もともとのご質問の回答だけさせてください。

ご質問内容の横持データのFIND処理ですと、下記のように記述できます。
念のため載せておきますね。

Sub myfind()

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Lastcoumns As Double

Dim key As String
Dim mymonth As String
Dim mystr As String

Set ws1 = Worksheets("年度別排出量")
Set ws2 = Worksheets("登録")

Lastcoumns = ws1.Range("a1").End(xlToRight).Column　’最大列番号を取得

key = ws2.Range("A1").Value
mystr = ws2.Range("H1").Value

Set myrange = ws1.Range(Cells(1, 1), Cells(1, Lastcoumns))　'検索範囲をセット

kensaku = myrange.Find(What:=key).Column　'検索範囲で列番号を取得

ws1.Cells(2, kensaku).Value = mystr ’検索列の下に使用時間を転記する

MsgBox "転記しました！"

Set ws1 = Nothing
Set ws2 = Nothing

End Sub

[masa1975]

おはようございます！
なるほど～、とても分かりやすく丁寧に教えて頂きありがとうございました。