インプット関数を使って・・（応用）

質問

インプット関数を使って・・でご教授頂き、解決したのに複雑になったら何故か転記できません。すみませんが、ふたたびご教授をいただきたいです。
シート１（データシート）
A列に通し番号（80001,80002,・・）B列に氏名、C列以降もデータがあり
J列に電話番号があります。インプットボックスに通し番号（80001などの番号）を入力すると80001に対応する氏名を（B２９へ）、電話番号を（F２９へ）としたいのですが、シート２（転記シート）へが表示できません。（一応「転記しました」と表示するのですが？）
データシートの２行目に項目、３行目からデータが入っています。

Sub 転記()
Dim Numv As Variant
Dim FindNum As Long
Dim wsNum As Long
Dim sNumv As Range

'検索する受付番号を取得
FindNum = InputBox("受付番号は", "番号の入力")
'キャンセルの場合の処理
If Len(Trim(FindNum)) = 0 Then Exit Sub

'"受付番号"列番号の自動取得
Set sNumv = Worksheets("データシート").Cells.Find(What:="受付番号")
'該当する受付番号は見つかったか?
If sNumv Is Nothing Then
MsgBox "受付番号がありません！", vbOKOnly, "エラー"

'プログラム終了
Exit Sub

Else
End If

'該当番号があった場合転記
With sNumv
.Copy.Offset(0, 2).Value = Worksheets("転記シート").Range("B29").Value

.Copy.Offset(0, 10).Value = Worksheets("転記シート").Range("F29").Value
End With
'転記成功メッセージを表示
MsgBox "転記しました", vbInformation
Worksheets("転記シート").Select

End Sub

回答No.2

KenKen_SP · ベストアンサー

こんにちは、hirosatonn さん。KenKen_SP です。

実は前回の私が書いたコードの転記部分にミスがあって、心配してました。
混乱させてしまい、申し訳ないです。

頑張ってらっしゃいますね。ご提示いただいたコードを拝見すると分かります。
ご質問の内容や、やりたいことが良く伝わりました。

できるだけ、hirosatonn さんのコードを尊重したかったのですが、コード記述
都合で勝手ながら手を入れさせて頂きました。

問題点は2点。

　・入力された受付番号を探すコードがない
　・転記部分のコード記述の文法上のミス

提案事項として。

　・InputBox には InputBox関数とInputBoxメソッドの2種類ある
　　これをヘルプで調べてみて下さい。どちらも機能的には変わらないのですが、
　　InputBoxメソッドはユーザーからの入力値の型（数値とか文字列）を限定
　　させることができます。
　　受付番号が 00001 など 0 で始まる文字列である場合を考慮すると、文字列
　　型の変数で受けた方が良いかと思います。

ご参考下さい。

Sub 転記()

　　Dim strCode As String
　　Dim rngSA　 As Range
　　Dim rngFC　 As Range

　　'検索する受付番号を取得
　　'00001 とかの0で始まる文字列の数字があるかも知れないので文字列型で受ける
　　strCode = Application.InputBox("受付番号は", "番号の入力", Type:=2)
　　'キャンセルの場合の処理
　　If UCase$(strCode) = "FALSE" Then Exit Sub

　　'受付番号の検索範囲を取得(A1～A列最終行まで）
　　Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp))
　　'受付番号の検索範囲から入力された受付番号を探す
　　Set rngFC = rngSA.Find(What:=strCode, LookAt:=xlWhole)

　　'該当する受付番号が無ければ警告を表示して終了
　　If rngFC Is Nothing Then
　　　　MsgBox "受付番号がありません！", vbOKOnly Or vbCritical, "エラー"
　　　　Exit Sub
　　End If

　　'該当番号があった場合転記
　　With Sheets("転記シート")
　　　　.Range("B29").Value = rngFC.Offset(0, 1).Value '1つ横＝B列
　　　　.Range("F29").Value = rngFC.Offset(0, 9).Value '9つ横＝J列
　　End With

　　'後始末：変数をクリア（お約束みたいなものです）
　　Set rngFC = Nothing
　　Set rngSA = Nothing

　　'転記成功メッセージを表示
　　MsgBox "転記しました", vbInformation
　　Sheets("転記シート").Select

End Sub

補足

KenKen_SP さん今回も色々と助けていただきありがとうございます。
さっそく実行させていただいたところ、
＞Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp))
で　『実行時エラー'9'　インデックスが有効範囲にありません』
になります。

回答No.7

imogasi

Sheet1のA1:D８に
番号 氏名 住所 電話
80001 山田 東京 ２３４５－１２２３
80002 大田 愛知 ２３４５－１２２４
80003 近藤 大阪 ２３４５－１２２５
80004 木村 奈良 ２３４５－１２２６
80005 北田 和歌山 ２３４５－１２２７
80006 西川 神奈川 ２３４５－１２２８
80007 北山 富山 ２３４５－１２２９
とします。
Sheet2に１つボタンをはりつけ、そのクリックイベントに
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
p01:
X = InputBox("番号=")
Set y = sh1.Range("a1:a100").Find(What:=X, After:=Range("a2"), LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, MatchByte:=False, SearchFormat:=False)
If y Is Nothing Then
MsgBox "その番号は見つかりません"
GoTo p01
Else
sh2.Cells(29, "B") = y.Offset(0, 1)
sh2.Cells(29, "C") = y.Offset(0, 2)
sh2.Cells(29, "F") = y.Offset(0, 3)
End If
End Sub
ボタンをクリックすると
番号を聞いてきて答えると、その方の氏名、住所、電話番号をSheet2
のB,C,F列２９行にセットします。
Sheet2の使用目的は何ですか。
同じ番号の方は２人いないと前提になったりしてます。
初心者はデータを移すのにCopy（メソッド）を使うのはどうかと思う。
ActiveSheet.Pasteのところでつまずきやすいからです。
今もってこの辺の（なぜそういう風にマイクロソフトがしたか）理屈がよくわからない。私は、代入法（A=B式）をお勧めします。値しか移せませんが。

回答No.6

KenKen_SP

あ、、どうも。

Wendy02 さんがフォローして下さっていることに気づかず、同じような内容の投稿をしてしまいました。
ありがとうございます。

お礼

KenKen_SP さん
最後までありがとうございました。
望んでいたものが、十分すぎるくらい出来ました。
又、お力を貸してもらうことがあるかもしれません。その時は、宜しくお願いいたします。

回答No.5

KenKen_SP

こんにちは。

コードの最後で、

　　Sheets("転記シート").Select

として、アクティブシートを変更したのが原因です。
下記のようにコードの一部を変更して下さい。

【訂正前】

　　'受付番号の検索範囲を取得(A1～A列最終行まで）
　　Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp))

【訂正後】

　　'受付番号の検索範囲を取得(A1～A列最終行まで）
　　With Sheets("データシート")
　　　　Set rngSA = .Range("A1", .Range("A65536").End(xlUp))
　　End With

回答No.4

Wendy02

KenKen_SP さんには、申し訳ないけれども、

＞ '受'受付番号の検索範囲を取得(A1～A列最終行まで）
＞ Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp))

基本的なことですが、エラーメッセージのとおり、Range("A65536")のオブジェクトが定まっていません。Rangeオブジェクトは、ふたつのクラスがありますが、なしにすると、Application となって、具体的には、ActiveSheet に属してしまうので、最初の部分、Sheets("データシート").Range("A1")との整合性が合いません。

そのコードが通る時は、ActiveSheetと、Sheets("データシート")　が一致する時、つまり、ActiveSheet が、データシートの時にのみになります。

ですから、この場合、正式に書くなら、
Set rngSA = Sheets("データシート").Range("A1",Sheets("データシート"). Range("A65536").End(xlUp))

となりますが、可読性が落ちますので、省略して、以下のようにしたらよいと思います。

With Sheets("データシート")
Set rngSA = .Range("A1", .Range("A65536").End(xlUp))
End With

と「．（コンマ）」を入れてください。なるべく、Withステートメントは使ったほうがよいですね。

よけいなことでしたら、すみません。

お礼

Wendy02　さんVBA駆け出しの者に分かりやすいご説明ありがとうございました。おかげさまで望んでいたものが、出来ました。

回答No.3

KenKen_SP

> Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp))
> で『実行時エラー'9'　インデックスが有効範囲にありません』

Sheets("～") はシート名を指定する命令ですが、この場合「データシート」
という名前のシートが無いとエラー、

『実行時エラー'9'　インデックスが有効範囲にありません』

が発生します。

コード内に書かれたシート名と実際のシート名が一致しているか確認して
下さい。

補足

すみませんです。コード内に書かれたシート名と実際のシート名が一致していないのを確認し忘れました。（寝起きだったもので・・）
実際のシート名に変えて、実行すると、１回だけ成功しましたが、別の数字（受付番号）をすると
> Set rngSA = Sheets("データシート").Range("A1", Range("A65536").End(xlUp))
の部分が、

今度は、'1004'アプリケーション定義またはオブジェクト定義エラーです。
私の浅はかな知識では、駄目です。

回答No.1

Wendy02

こんばんは。
あまり、細かく見ていないけれど、こういうことではないでしょうか？
Copy メソッドと混在になっています。

With sNumv
　　 Worksheets("転記シート").Range("B29").Value = .Offset(0, 2).Value
　　 Worksheets("転記シート").Range("F29").Value = .Offset(0, 10).Value
End With