インプトボックス関数を使って・・

質問

A列：通し番号１から順に,B列：氏名,C列：電話番号 等
データの入ったシート１からインプットボックスに通し番号の数字を入力してOKボタンを押すと、該当するの氏名、電話番号が別のシート２の設定場所、たとえば、セルC1へ氏名、セルE1へ電話番号を移す方法を。マクロがうまくいきません。

回答No.5

KenKen_SP · ベストアンサー

#3 です。

> Worksheets("Sheet2").Range("C1") = _
> Worksheets("Sheet1").Cells(Numv + 1, 3)

ご質問文によると、氏名は Sheet1 の B 列ですから、ここは

Worksheets("Sheet2").Range("C1") = _
Worksheets("Sheet1").Cells(Numv + 1, 2)

かと。同様に電話番号は Sheet1 の C 列ですから、

Worksheets("Sheet2").Range("E1") = _
Worksheets("Sheet1").Cells(Numv + 1, 3)

ということでしょうか？

Cells(Numv + 1, 3) のように +1 してるのは、A1 が見出しで
A2 から番号が始まってるからかな？

それから、余談ですが、

> Dim Numv As Integer

は　Dim Numv As Long　にして下さい。Integer 型は16ビット
の変数で 、-32,768 ～ 32,767 の範囲の整数しか扱えません。

Excel の最大行番号は 65,636 なので Long を使った方が間違い
ありません。

お礼

ありがとうございます。
これの応用がうまくいきません。
ご教授いただければ・・・

回答No.4

hana-hana3

動作には問題無いようですが・・・。
うまく行かないのは、どの動作なのですか？

＞Cells(Numv + 1, 3)

"+ 1" する理由はなんでしょうか？

データチェックに関しては、
Dim Numv As Variant
Dim min As Long
Dim max As Long

min = 1
max = 1000

'InputBoxで番号を入力させて移す
Do
Numv = Application.InputBox("番号を入力してください。", "番号入力", Type:=2)
If TypeName(Numv) <> "Boolean" Then
If Numv >= min And Numv <= max Then Exit Do
Else
Exit Sub
End If
Loop
のようにすると良いかも知れません。

回答No.3

KenKen_SP

こんにちは。KenKen_SP です。

他の方もコメントされてますが、、、

1.　ご自分でどこまでやったのでしょうか?
2.　どのようにうまくいかないんでしょうか?
3.　使うソフト名とバージョン、OS名は?

これらの情報がないと、推測による回答になってしまいます。直ぐに回答が
ほしい、とありますので、ご質問文から推測し得る範囲で書いたサンプルを
アップしてみます。ご参考下さい。

Sub Sample()

　　Dim strCode　　　 As String
　　Dim lngEndRow　　 As Long
　　Dim rngSearchArea As Range
　　Dim rngFoundCell　As Range

　　'A列の最終データがある行番号を取得
　　lngEndRow = Range("A65536").End(xlUp).Row
　　'番号の検索範囲を取得
　　Set rngSearchArea = Sheets("Sheet1").Range("A2:A" & lngEndRow)

　　'InputBoxメソッドで番号を入力させる
　　strCode = Application.InputBox(Prompt:="番号を入力", Type:=2)
　　'キャンセルの場合の処理
　　If UCase$(strCode) = "FALSE" Then Exit Sub
　　'入力された番号のデータを探がす
　　Set rngFoundCell = rngSearchArea.Find(What:=strCode)
　　'該当するセルは見つかったか?
　　If rngFoundCell Is Nothing Then
　　　　'変数rngFoundCellが空なら該当セルがないのでメッセージ表示
　　　　MsgBox "該当セルはありません", vbExclamation, "検索結果"
　　　　'プログラム終了
　　　　Exit Sub
　　Else
　　　　'該当セルがあった場合
　　　　With rngFoundCell
　　　　　　'該当セルから1列横のセルの値をSheet2!C1に転記
　　　　　　.Offset(0, 1).Value = Sheets("Sheet2").Range("C1").Value
　　　　　　'該当セルから2列横のセルの値をSheet2!E1に転記
　　　　　　.Offset(0, 2).Value = Sheets("Sheet2").Range("E1").Value
　　　　End With
　　　　'転記成功メッセージを表示
　　　　MsgBox "転記しました", vbInformation
　　End If

　　'後始末
　　Set rngFoundCell = Nothing
　　Set rngSearchArea = Nothing

End Sub

補足

サンプルまでありがとうございます。
エクセル２００２でのOSはXPです。
マクロは駆け出しなもので私が考えたのは次のとおりです。
Sub 転記()

Dim Numv As Integer

'InputBoxで番号を入力させて移す
Numv = Application.InputBox("番号を入力してください。", "番号入力", Type:=2)

Worksheets("Sheet2").Range("C1") = _
Worksheets("Sheet1").Cells(Numv + 1, 3)
Worksheets("Sheet2").Range("E1") = _
Worksheets("Sheet1").Cells(Numv + 1, 4)
End Sub

回答No.2

merlionXX

どう、うまくいかないんでしょうか？

Sheet1のＡ1からデータが入っている場合、以下のような感じになると思いますが。

Sub test()
ans = Application.InputBox("番号を入力してね", type1)
Sheet2.Cells(1, 3) = Sheet1.Cells(1, 2).Offset(ans - 1)
Sheet2.Cells(1, 5) = Sheet1.Cells(1, 3).Offset(ans - 1)
End Sub

回答No.1

hana-hana3

＞マクロがうまくいきません。

どこがうまく行かないのですか？
うまく行かない部分の症状とその前後のコード等を提示してください。