必要なデータを抽出したい

質問

必要なデータを抽出したい

　　　A　　　B　　　　C　　　D　・・・
１　7/1　　　101　　　102　　103
２　7/2　　　101　　　103
３　7/3　　　105　　　203
４　7/4　　　103　　　205
５　7/5　　　101　　　202
・　・　　　　・
・　・　　　　・
・　・　　　　・

Excelで上の様にA列に日付、B行列以降に数字が書かれているシートから、抽出したい数字が含まれている行を別シートに抽出するマクロはどのように書けばよろしいのでしょうか。
技術者の方、よろしくお願いします。
例えば、101が含まれているデータを抽出したら、sheet2に

　　　A　　　B　　　　C　　　D
１　7/1　　　101　　　102　　103
２　7/2　　　101　　　103
３　7/5　　　101　　　202

となるようにしたいのです。

回答No.5

mu2011

NO3です。
Ｂ列以降も検索コードがある事を失念していましたので訂正します。

＜サンプルコード＞
Sub シート1を検索して結果をシート2()
Dim key As Integer
key = InputBox("抽出コードを入力して下さい。", "抽出コードの入力")
b = 1
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
For k = 2 To Cells(i, Columns.Count).End(xlToLeft).Column
If Cells(i, k) = key Then
Sheet1.Rows(i).Copy Destination:=Sheet2.Rows(b)
b = b + 1
Exit For
End If
Next
Next
End Sub

回答No.4

banzaiA

回答というより、
補足説明の要請です。

＞抽出したい数字がふくまれている
というのは、例ではＢ列だけですが、Ｃ列以降にもあるのかどうか？

つまり抽出する数字は、Ｂ列だけを探せばいいのかを教えて下さい。

補足

>>例ではＢ列だけですが、Ｃ列以降にもあるのかどうか？

C列以降にもあります

回答No.3

mu2011

一例です。
データをシート1、抽出をシート２として、抽出コードを入力する方法です。

シート１タブ上で右クリック→コードの表示→以下のサンプルコードを貼り付けてマクロ実行してください。

Sub シート1を検索して結果をシート2()
Dim key As Integer
key = InputBox("抽出コードを入力して下さい。", "抽出コードの入力")
b = 1
For Each a In Sheet1.Range("B:B")
If a.Value = key Then
Sheet1.Rows(a.Row).Copy Destination:=Sheet2.Rows(b)
b = b + 1
End If
Next
End Sub

回答No.2

tom04

No.1です！
たびたびごめんなさい。

前回のコードでは後半部分に間違いがありましたので
正確に表示されないと思います。
↓のコードに訂正してみてください。

Sub test()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ws1.Cells(i, Columns.Count).End(xlToLeft).Column
If ws2.Cells(1, 1) = "" Then Exit Sub
If WorksheetFunction.CountIf(ws1.Rows(i), ws2.Cells(1, 1)) Then
ws2.Cells(i + 1, j) = ws1.Cells(i, j)
End If
ws2.Cells(i + 1, 1).NumberFormatLocal = "m/d"
Next j
Next i
Dim k As Long
For k = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
If WorksheetFunction.Count(ws2.Rows(k)) = 0 Then
ws2.Rows(k).Delete (xlUp)
End If
Next k
End Sub

以上、何度も失礼しました。m(__)m

回答No.1

tom04

こんにちは！
当方は技術者ではありませんが・・・（建築関係の技術職ではあります）

↓の画像のような配置の場合のコードです。

Sheet2のA1セルに検索したい値を入力すればその行が表示されると思います。

Sub test()
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To ws1.Cells(i, Columns.Count).End(xlToLeft).Column
If ws2.Cells(1, 1) = "" Then Exit Sub
If WorksheetFunction.CountIf(ws1.Rows(i), ws2.Cells(1, 1)) Then
ws2.Cells(i + 1, j) = ws1.Cells(i, j)
End If
ws2.Cells(i + 1, 1).NumberFormatLocal = "m/d"
Next j
Next i
Dim m, n As Long
For m = ws2.Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
For n = 1 To ws2.UsedRange.Columns.Count
If ws2.Cells(m, n) = "" Then
ws2.Cells(m, n).Delete (xlUp)
End If
Next n
Next m
End Sub

以上、かなり無理やりって感じのコードですので
他に良い方法があれば読み流してくださいね。m(__)m