[[20210327012005]]　『転記』（チョコ）　ページの最後に飛ぶ

『転記』（チョコ）

ユーザーフォームのテキストボックスに日付を入力し転記ボタン押しで別シートの日付（A列)と一致した日付行にデータを転記したいです。
どのようなマクロでできるようになるか教えて頂きたく。
よろしくお願いします。

テキストボックス
　　　　　1/1　転記ボタン
データ　
　　　A 　　　 B 　　　C 　
1 　　亀　　　鳥
2　　　　　　　

　　　　　↓

別シート
　　　A 　　　 B 　　C 　
1 １月１日　　亀　　　鳥
2 １月２日

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

お困りのポイントがよくわかりません。どこまでできてるんですか？

よくわかりませんが、やることは

 (1) 日付を入力するテキストボックスから、【日付】データを取得する
 (2) Match関数やFindメソッドで、別シートの日付（A列)から該当する【行】を調べる
 (3) (2)で調べた行の該当する【列】にテキストボックスの値を書き込む

ということですよね？

（もこな２） 2021/03/27(土) 05:37

もこな2さん
返信ありがとうございます。

データシートA1亀 B1鳥があります。転記ボタンがありユーザーフォーム内の
テキストボックスに日付を入力し登録ボタンでその日付と一致する別シート日付行
B1C1に転記したいと考えています。
（テキストボックスに1／1と入力登録で別シートの1月1日横に転記）
説明下手ですみません。

申し訳ないのですがはじめから教えていただけないでしょうか。
よろしくお願いします。

（チョコ） 2021/03/27(土) 07:32

再掲。
【どこまで】できてるんですか？
行を探す部分なのか、転記をする部分なのかわからない部分がわかりません。

（もこな２） 2021/03/27(土) 08:09

行を探すのと転記両方教えて下さい。
（チョコ） 2021/03/27(土) 08:33

聞き方変えますね。何はできていますか？
（何も手を付けてなくて、ただ完成品がほしいだけなら興味がないので私は降ります）

シートは作ってあるとか、ユーザーフォームや、コントロールはできてるとかその辺教えてください。
また、シートが作ってあるなら、項目行含めて5～6行のサンプルを提示してください。

（もこな２） 2021/03/27(土) 08:42

度々すみません。

色々試したのですがうまくいかなくて。

Private Sub CommandButton1_Click()

Dim wb As Workbook
Workbooks.Open ThisWorkbook.Path & "test.xlsm"
Set wb = ActiveWorkbook

Dim myRange As Range
Dim myObj As Range

Set myRange = wb.Worksheets(1).Range("A1:A100")

Set myObj = myRange.Find(UserForm2.TextBox1.Value, LookAt:=xlWhole)

myObj.Offset(0, 1) = ThisWorkbook.Worksheets(1).Range("A1").Value

Unload Me

End Sub
（チョコ） 2021/03/27(土) 08:56

 テキストボックスの1／1を検索値で別シートの1月1日(シリアル値?)を
そのままでは検索出来ないでしょね
Findメソッドで日付を検索するのは以外と面倒です
(参考)
日付を検索する
http://officetanaka.net/excel/vba/tips/tips131b.htm
（どん） 2021/03/27(土) 10:04

どんさん
返信ありがとうございます。
ご指摘の部分がよくわからなくて。
またあとで色々試してみたいと思います。

（チョコ） 2021/03/27(土) 11:16

既にコメントがあるように、日付型データをFindメソッドで探そうとするとちょっとめんどうなので、Match関数の例です。

    Private Sub CommandButton1_Click()
        Dim wb As Workbook
        Dim 行 As Variant
        Dim 日付 As Date

        '▼書き込み先のブックが開いてなかったときだけ開く
        On Error Resume Next
        Set wb = Workbooks("test.xlsm")
        On Error GoTo 0
        If wb Is Nothing Then
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\test.xlsm") '（\ が抜けていたので修正）
        End If

        '▼日付を"日付型"データとして取得する（Excel君に忖度してもらう）
        日付 = TextBox1.Value

        '▼書き込む行を探す
        行 = Application.Match(CLng(日付), wb.Worksheets(1).Range("A1:A100"), 0)

        '▼書き込む行が見つかった時だけ処理する
        If Not IsError(行) Then
            ThisWorkbook.Worksheets("データ").Range("A1:B1").Copy wb.Worksheets(1).Cells(行, "B")
        End If

    End Sub

（もこな２） 2021/03/27(土) 11:20

もこな2さん

わかりやすい回答ありがとうございます。
今、試すことが出来ないので後で試してみたいと
思います。

（チョコ） 2021/03/27(土) 12:16

https://excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=193469&rev=0

（じじ） 2021/03/27(土) 14:48

もこな２さん

下記コードで実行時エラー424
オブジェクトが必要ですとなります。

どこが悪いのでしょうか？

 ThisWorkbook.Worksheets("データ").Range("A1:B1").Copy wb.Worksheets(1).Cells(行, "B")
（チョコ） 2021/03/27(土) 22:51

エクセルサロンのほうがマルチポストを禁止しているので、こちらで話を続けるなら先に向こうを閉じるべきですよ。

向こうで続けるなら、こちらにその旨書き込んでください。

（もこな２） 2021/03/27(土) 23:43

こちらでお願いします、もこな２さん。

その部分は(１)にしています。
これではだめでしょうか？

ThisWorkbook.Worksheets(１).Range("A1:B1").Copy wb.Worksheets(1).Cells(行, "B")

　　　　　　　　　　　　
　　　　　　　　　　　
（チョコ） 2021/03/27(土) 23:52

エクセルサロン閉じたのを拝見しましたけど、一方的すぎやしませんかね・・・・
ちゃんと、マルチポストしていたことと、こちらで続ける旨書いたほうがよかったでしょう。
なんなら、こちらでも都合が悪くなったら途中で放り出すのではないかと危惧します。

＞その部分は(１)にしています。
うっかり書き込んだの見ちゃいましたか・・・まぁ、それだとシート名は原因ではないですね。
そのエラーが出るとき、「行」と「wb」には何が格納されているか教えてください。

また、↓のように修正したらどうなるか教えてください。

 ThisWorkbook.Worksheets(1).Range("A1:B1").Copy wb.Worksheets(1).Cells(行, "B")

↓

 ThisWorkbook.Worksheets(1).Range("A1:B1").Copy
 wb.Worksheets(1).Paste Destination:=wb.Worksheets(1).Cells(行, "B")

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

 変数 行 の値がうまくないんだと思います。
 日付 = CDate(TextBox1.Value)
 行 = Application.Match(CLng(日付), wb.Worksheets(1).Range("A1:A100"), 0)

 だと思いますよ。
 TextBox1.Value は文字列なので、→シリアル値→整数　の2段階の変換が必要です。
（´・ω・`） 2021/03/28(日) 00:45

修正版を実行するとエラーが出ず数式が転記されるのでValueを入れたのですが
Valueを入れると同じエラー（オブジェクト必要）が返されます。
「行」と「wb」格納はわからないです。
初心者で申し訳ありません。

ThisWorkbook.Worksheets(1).Range("A1:B1").Value.Copy

                                            ↑
                                         　値を転記したいのでValue挿入
　　　　　　　　　　　　　　　　　　　
 wb.Worksheets(1).Paste Destination:=wb.Worksheets(1).Cells(行, "B")
（チョコ） 2021/03/28(日) 01:07

（´・ω・`）さんこんばんは。

日付 = CDate(TextBox1.Value)
上記も試してみましたが数式が転記されました。

転記元のセルには計算式が入っているのでその値を
転記したいです。

説明不足で申し訳ありません。

Value.Copyではオブジェクトエラーが出てしまいます。
（チョコ） 2021/03/28(日) 01:23

何点か確認。

■１
＞「行」と「wb」格納はわからないです。
ブレークポイントを設定してステップ実行してますか？

「ステップ実行」が分からない場合は↓参照

 【ステップ実行】
https://www.239-programing.com/excel-vba/basic/basic023.html
http://plus1excel.web.fc2.com/learning/l301/t405.html

 ついでに↓も覚えてしまいましょう。

 【イミディエイトウィンドウ】
https://www.239-programing.com/excel-vba/basic/basic024.html
https://excel-ubara.com/excelvba1/EXCELVBA486.html

 【ローカルウィンドウ】
https://excel-ubara.com/excelvba4/EXCEL266.html
http://excelvba.pc-users.net/fol8/8_2.html

■２
UserForm2.TextBox1.Value　には何がはいっているのですか？
（´・ω・`）さんの指摘については↓のようにしてるので、型が一致しないっていうエラーがでないなら、Excel君のほうでなんとかしてくれてるとおもいますが・・・

 Dim 日付 As Date

■３

 ThisWorkbook.Worksheets(1).Range("A1:B1").Value.Copy

↑は構文としておかしいです。
「マクロの記録」機能をつかって

 (1)コピー範囲をコピーする
 (2)貼付したいセルで右クリック
 (3)形式を選択して貼り付け - 値

という操作をして、どのような命令が必要か研究してみましょう。

■４
もう一度確認。
「行」「wb」「日付」には何が格納されてますか

■５
こちらも、もう一度確認
↓のように修正したらどうなるか教えてください。
（エラーが出る場合、どの箇所でなんというエラー（エラー番号、エラーメッセージ）がでるのか）

 ThisWorkbook.Worksheets(1).Range("A1:B1").Copy wb.Worksheets(1).Cells(行, "B")
                ↓
 ThisWorkbook.Worksheets(1).Range("A1:B1").Copy
 wb.Worksheets(1).Paste Destination:=wb.Worksheets(1).Cells(行, "B")

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

■３　.Range("A1:B1").Selection.PasteSpecial Paste:=xlPasteValues

■４「行」はテキストボックスに1/1と入力で 1 : Variant/Double
　　「日付」は #2021/01/01# : Date
　　「wb」は何が入っているかわからないです。　wb : : Workbook/ThisWorkbook

■５　テキストボックス1/1実行でエラーは出ませんでした。
　　　転記先のB1セルに計算式がコピーされていました。
　　　
もこな２さん、上記のような結果でした。
（チョコ） 2021/03/28(日) 13:02

 >転記先のB1セルに計算式がコピーされていました。

 これのどこが不満なんですかね？
 セルのコピーって何やっているか解ってますか？
 少しは自分で考えましょう。
（基本） 2021/03/28(日) 13:15

■３のレス
コピーする部分まで理解してほしかったですが・・・
（対象シートまで理解できてれば）まぁ間違いではないです

■４のレス
＞「wb」は何が入っているかわからないです。
おそらく（変えてなければ）、「tes.xlsm」がセットされてますよ。
そうなると、

 テキストボックスに「1/1」という"文字列"が入っていて
 Date型の変数に格納したときに「2021/01/01」と解釈され
 test.xlsmの１番目のシートのA列の１～100行目までをMatch関数で「2021/01/01」をキーにして調べた結果
 1行目でヒットしたので【行】に１が格納された

ということなので、正常に動いてますね。

＞テキストボックス1/1実行でエラーは出ませんでした。
えっと、↓でエラーが出てるという話ではありませんでしたか？

 ＞下記コードで実行時エラー424
 ＞オブジェクトが必要ですとなります。

次投稿へ続きます。

（もこな２） 2021/03/28(日) 13:33

■６
「■５」でエラーにならなくて、値のみ転記したいということであれば↓とか

    Private Sub CommandButton1_Click()
        Dim wb As Workbook
        Dim 行 As Variant
        Dim 日付 As Date

        Stop

        On Error Resume Next
        Set wb = Workbooks("test.xlsm")
        On Error GoTo 0
        If wb Is Nothing Then
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\test.xlsm")
        End If

        日付 = TextBox1.Value
        行 = Application.Match(CLng(日付), wb.Worksheets(1).Range("A1:A100"), 0)

        If Not IsError(行) Then
            ThisWorkbook.Worksheets(1).Range("A1:B1").Copy
            wb.Worksheets(1).Cells(行, "B").PasteSpecial Paste:=xlPasteValues
        End If
    End Sub

↓のようにすればよいと思いますよ

    Private Sub CommandButton1_Click()
        Dim wb As Workbook
        Dim 行 As Variant
        Dim 日付 As Date

        Stop

        On Error Resume Next
        Set wb = Workbooks("test.xlsm")
        On Error GoTo 0
        If wb Is Nothing Then
            Set wb = Workbooks.Open(ThisWorkbook.Path & "\test.xlsm")
        End If

        日付 = TextBox1.Value
        行 = Application.Match(CLng(日付), wb.Worksheets(1).Range("A1:A100"), 0)

        If Not IsError(行) Then
            With ThisWorkbook.Worksheets(1).Range("A1:B1")
                wb.Worksheets(1).Cells(行, "B").Resize(, .Columns.Count).Value = .Value
            End With
        End If

    End Sub

（もこな２） 2021/03/28(日) 13:42

もこな２さん

無事値のみ転記されました。

今回は長い時間付き合ってくださって本当にありがとうございました。
失礼な所もあったかと思いますがご容赦ください。

では失礼します。

（チョコ） 2021/03/28(日) 14:08

うーん。結局エラーが発生した原因はなんだったんでしょうか。
そして、何よりどのような処理をしているか理解できたんでしょうか。
正直、コードがもらえたからおさらば感が否めないです。
（回答するんじゃなかったかなぁ・・・・）

ちなみに、

 ・「test.xlsm」ってマクロ付きブックじゃなきゃだめなの？
 ・ユーザーフォームで処理せず、セルに日付を入力して、シート上にActiveXコントロール置くのじゃだめなの？
 ・コマンドボタン押すたびに「test.xlsm」が開いてるか判定するのってめんどくさくない？

など、ツッコミたい部分がほかにもありましたが、話は終わりのようなので、どうでもいいですかね・・・

（もこな２） 2021/03/28(日) 14:30

コメント返信：

[ 一覧(最新更新順) ]

[[20210327012005]] 『転記』（チョコ） ページの最後に飛ぶ

[[20210327012005]]　『転記』（チョコ）　ページの最後に飛ぶ