![](http://oshiete.xgoo.jp/images/v2/pc/qa/question_title.png?a65a0e2)
Excelのuserformのtextboxに入力された番号をA列から検索して
該当する行を別シートに転記するVBAを教えてください。
A列の番号は昇順で並んでおり、同じ番号は最大10回続きます。
同じ番号ならB列からE列は列ごとに同じ文字が入ります。
1行目は項目名が入り、番号は2行目からです。
Sheet1
A B C D E F G H I J K
1
2 760 z b s h い ろ は に ほ へ
3 760 z b s h と ち り ぬ る を
4 760 z b s h わ か よ た れ そ
5 761 x n d j あ い う え お か
6 761 x n d j き く け こ さ し
7 762 v m f k ぬ ね の は ひ ふ
8 762 v m f k へ ほ ま み む め
9 762 v m f k も や ゆ よ ら り
10 762 v m f k る れ ろ わ を ん
・
・
・
760番を検索・転記する場合、Sheet2 A列に下記のように転記したいです。
1行目~3行目までは空欄
4行目はSheet1 D列の文字
5行目はSheet1 E列の文字
6行目以降はSheet1 F列~K列を行列入れ替えて縦一列に
Sheet2
A
1
2
3
4 s
5 h
6 い
7 ろ
8 は
9 に
10 ほ
11 へ
12 と
13 ち
14 り
15 ぬ
16 る
17 を
・ ・
・ ・
・ ・
例えば次に762番を検索・転記する場合、Sheet2にある文字は全部削除されて
A列4行目から同じように転記したいです。
よろしくお願いいたします。
No.2ベストアンサー
- 回答日時:
>もし検索した番号がなかった場合
>該当番号がありませんというmsgboxを表示したいのですが
>教えていただけますでしょうか。
以下のようにしてください。
No1のは破棄してください。
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow As Long
Dim srow As Long: srow = 0
Dim erow As Long: erow = 0
Dim row1 As Long
Dim row2 As Long
Dim sval As String
If TextBox1.Value = "" Then Exit Sub
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Cells.ClearContents
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row
For row1 = 2 To maxrow
sval = sh1.Cells(row1, "A").Value
If sval = TextBox1.Value Then
If srow = 0 Then srow = row1
erow = row1
End If
Next
If srow = 0 Then
MsgBox ("該当番号がありません")
Exit Sub
End If
sh2.Cells(4, "A").Value = sh1.Cells(srow, "D").Value
sh2.Cells(5, "A").Value = sh1.Cells(srow, "E").Value
row2 = 6
For row1 = srow To erow
sh2.Cells(row2, "A").Resize(6, 1).Value = WorksheetFunction.Transpose(sh1.Cells(row1, "F").Resize(1, 6))
row2 = row2 + 6
Next
End Sub
No.1
- 回答日時:
マクロを実行するトリガーが不明なので、コマンドボタンをクリックされた時と仮定して、作成しました。
もし、トリガーが他の場合は、プロシージャ名をそのように変えてください。
Private Sub CommandButton1_Click()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim maxrow As Long
Dim srow As Long: srow = 0
Dim erow As Long: erow = 0
Dim row1 As Long
Dim row2 As Long
Dim sval As String
If TextBox1.Value = "" Then Exit Sub
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
sh2.Cells.ClearContents
maxrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row
For row1 = 2 To maxrow
sval = sh1.Cells(row1, "A").Value
If sval = TextBox1.Value Then
If srow = 0 Then srow = row1
erow = row1
End If
Next
If srow = 0 Then Exit Sub
sh2.Cells(4, "A").Value = sh1.Cells(srow, "D").Value
sh2.Cells(5, "A").Value = sh1.Cells(srow, "E").Value
row2 = 6
For row1 = srow To erow
sh2.Cells(row2, "A").Resize(6, 1).Value = WorksheetFunction.Transpose(sh1.Cells(row1, "F").Resize(1, 6))
row2 = row2 + 6
Next
End Sub
ご回答ありがとうございます。
完璧にできました!
可能であれば、もう一点教えていただきたいのですが、
もし検索した番号がなかった場合
該当番号がありませんというmsgboxを表示したいのですが
教えていただけますでしょうか。
よろしくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) VBAで、1つのエクセルで、2つのシートからもう1つのシートに条件のある転記コードを教えてください。 1 2023/03/16 18:07
- Visual Basic(VBA) VBA 別sheetからの転記なのですが 2 2023/05/22 15:55
- Visual Basic(VBA) VBA 改行コードの取り方 1 2022/03/22 14:14
- Visual Basic(VBA) VBA シート間の転記で、条件の追加コードの書き方について教えて下さい。 13 2023/02/26 09:31
- Visual Basic(VBA) VBA 検索と入力 Excel ブック ぶぶぶ シート ししし 列V 検索対象の列です 最終行は、お 6 2023/05/17 01:40
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Excel(エクセル) 列を自動で追加したい 3 2022/07/11 12:58
- Visual Basic(VBA) VBAで、シート間の転記するコードをFOR~NEXTで教えてください。 9 2023/04/30 20:04
- Visual Basic(VBA) 【VBA】指定した検索条件に一致したら別シートに転記したい 2 2022/03/23 16:14
- Visual Basic(VBA) 改行ごとに行を追加し、数量を分割 4 2023/07/11 16:39
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・一番好きなみそ汁の具材は?
- ・泣きながら食べたご飯の思い出
- ・「これはヤバかったな」という遅刻エピソード
- ・初めて自分の家と他人の家が違う、と意識した時
- ・いちばん失敗した人決定戦
- ・思い出すきっかけは 音楽?におい?景色?
- ・あなたなりのストレス発散方法を教えてください!
- ・もし10億円当たったら何に使いますか?
- ・何回やってもうまくいかないことは?
- ・今年はじめたいことは?
- ・あなたの人生で一番ピンチに陥った瞬間は?
- ・初めて見た映画を教えてください!
- ・今の日本に期待することはなんですか?
- ・集中するためにやっていること
- ・テレビやラジオに出たことがある人、いますか?
- ・【お題】斜め上を行くスキー場にありがちなこと
- ・人生でいちばんスベッた瞬間
- ・コーピングについて教えてください
- ・あなたの「プチ贅沢」はなんですか?
- ・コンビニでおにぎりを買うときのスタメンはどの具?
- ・おすすめの美術館・博物館、教えてください!
- ・【お題】大変な警告
- ・洋服何着持ってますか?
- ・みんなの【マイ・ベスト積読2024】を教えてください。
- ・「これいらなくない?」という慣習、教えてください
- ・今から楽しみな予定はありますか?
- ・AIツールの活用方法を教えて
- ・最強の防寒、あったか術を教えてください!
- ・歳とったな〜〜と思ったことは?
- ・モテ期を経験した方いらっしゃいますか?
- ・好きな人を振り向かせるためにしたこと
- ・スマホに会話を聞かれているな!?と思ったことありますか?
- ・それもChatGPT!?と驚いた使用方法を教えてください
- ・見学に行くとしたら【天国】と【地獄】どっち?
- ・これまでで一番「情けなかったとき」はいつですか?
- ・この人頭いいなと思ったエピソード
- ・あなたの「必」の書き順を教えてください
- ・14歳の自分に衝撃の事実を告げてください
- ・人生最悪の忘れ物
- ・あなたの習慣について教えてください!!
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
「段」と「行」の違いがよくわ...
-
エクセルで離れた列を選択して...
-
列方向、行方向の定義
-
土日の列幅の自動変更を教えて...
-
横軸を日付・時間とするグラフ化
-
LEFT関数とIF関数の組み合わせ...
-
エクセルマクロPrivate Subを複...
-
エクセルのソートで、数字より...
-
エクセル マクロ 範囲指定で...
-
Accessのレポートで繰り返し表...
-
ListViewで列を指定して表示さ...
-
EXCELを最大にて開いた際、特定...
-
VBAで結合セルを転記する法を教...
-
Excel文字列一括変換
-
VLOOKUPの列番号の最大は?
-
VBA 指定した列にある日時デー...
-
CSVファイルの「0落ち」にVBA
-
エクセルで?
-
Excelの行数、列数を増やしたい...
-
csvに別のExcelの文章を差し込む
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
「段」と「行」の違いがよくわ...
-
エクセルで離れた列を選択して...
-
VLOOKUPの列番号の最大は?
-
LEFT関数とIF関数の組み合わせ...
-
VBA 指定した列にある日時デー...
-
Excelの行数、列数を増やしたい...
-
エクセル マクロ 範囲指定で...
-
列方向、行方向の定義
-
Excel文字列一括変換
-
エクセルのソートで、数字より...
-
エクセルマクロの組み方
-
エクセルでセル12個間隔で合...
-
VBAで結合セルを転記する法を教...
-
エクセルマクロPrivate Subを複...
-
ListViewで列を指定して表示さ...
-
エクセルで最初の行や列を開け...
-
横軸を日付・時間とするグラフ化
-
CSVファイルの「0落ち」にVBA
-
VBAで別ブックの列を検索し、該...
-
エクセルの行を65536以上に増や...
おすすめ情報