人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルのマクロで質問です。

基本的なマクロはわかるのですが

シート1の特定行に「ABC」という文字が含まれていたら
シート2にその行をコピーするという事がしたいとおもっております。

シート1は成績
シート2は合否

シート1の成績で合格とかかれている人の行を
シート2に書き出すといったイメージです。

これがマクロで出来るのかどうかは不明ですが
方法があれば教えていただければと思います。

●質問者: quocard
●カテゴリ:コンピュータ インターネット
✍キーワード:ABC イメージ エクセル コピー マクロ
○ 状態 :終了
└ 回答数 : 3/3件

▽最新の回答へ

1 ● きゃづみぃ
●27ポイント

Sub Macro1()

'

' Macro1 Macro

'

Sheets("Sheet1").Select

Sheets("Sheet1").Range("A1").Select

Sheets("Sheet1").Cells.Find(What:="ABC", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

, MatchByte:=False, SearchFormat:=False).Activate

Rows(Selection.Row & ":" & Selection.Row).Copy

Sheets("Sheet2").Select

Sheets("Sheet2").Range("A1").Select

Selection.End(xlDown).Select

If Selection.Row = 65536 Then

MsgBox "貼り付けができません。"

End

End If

Cells(Selection.Row + 1, 1).Select

ActiveSheet.Paste

End Sub

こんな感じでいかがでしょうか?

◎質問者からの返答

ありがとうございます。

こんなに早くくるなんておもってなかったです。

参考にさせていただきます。


2 ● きゃづみぃ
●27ポイント

Sub Macro1()

'

' Macro1 Macro

'

On Error GoTo ending

a = "ABC" '検索キーワード

b = 0

Sheets("Sheet1").Select

Sheets("Sheet1").Range("A1").Select

start:

Sheets("Sheet1").Cells.Find(What:=a, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _

xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _

, MatchByte:=False, SearchFormat:=False).Activate

If b > Selection.Row Then GoTo ending

b = Selection.Row

Rows(b & ":" & b).Copy

b = b + 1

Cells(b, 1).Select

Sheets("Sheet2").Select

Sheets("Sheet2").Range("A1").Select

Selection.End(xlDown).Select

If Selection.Row = 65536 Then

MsgBox "貼り付けができません。"

End

End If

Cells(Selection.Row + 1, 1).Select

ActiveSheet.Paste

Sheets("Sheet1").Select

GoTo start

ending:

End Sub



検索箇所が複数あるシートに対応にしました。

◎質問者からの返答

複数箇所にまで対応していただきありがとうございます。

こちらも参考にさせていただきます。


3 ● Mook
●26ポイント

マクロを複数回実行した場合、該当行が既に合否シートにあるかどうかを判断するのが難しかったので、毎回コピー先シートの2行目以降をクリアしてから

新たにコピーする処理になっています。

先頭の部分を実際に使用する内容に変えて実行してみてください。

Option Explicit
Const srcWSName = "成績" '--- 検索元シート名
Const dstWSName = "合否" '--- コピー先シート名

Const searchRange = "B:D" '--- 検索元 検索範囲
Const searchWord = "ABC" '--- 検索元 検索文字列

'------------------------------------------
Sub searchAndCopy()
'------------------------------------------
 Dim srcWS As Worksheet
 Set srcWS = Worksheets(srcWSName)
 If srcWS Is Nothing Then
 MsgBox srcWSName & "がありません"
 End If

 Dim dstWS As Worksheet
 Set dstWS = Worksheets(dstWSName)
 If dstWS Is Nothing Then
 MsgBox dstWSName & "がありません"
 End If

 Dim resRng As Range
 Dim fstRng As Range
 Dim dstLine As Long

 '--- 書き込み先の2行目から書き出し:最初に2行目以降をクリア
 dstLine = 2
 dstWS.Rows(dstLine & ":" & dstWS.Range("A" & dstWS.Rows.Count).End(xlUp).Row).Clear

 '--- 検索先シートの serachRange で serachWord を検索
 With srcWS.Range(searchRange)
 Set resRng = .Find(what:=searchWord, lookat:=xlPart)
 If resRng Is Nothing Then
 MsgBox "コピーする行がありませんでした。"
 Exit Sub
 End If
 Set fstRng = resRng
 Do
 '--- 見つかったら書き込み先のシートにコピー
 resRng.EntireRow.Copy Destination:=dstWS.Rows(dstLine)
 dstLine = dstLine + 1
 Set resRng = .FindNext(resRng)
 Loop While resRng.Address <> fstRng.Address
 End With
End Sub
◎質問者からの返答

ありがとうございます。

こちら変数で指定しやすいようにしてくださり

とても感謝しております。

こういったものを作れるようにがんばりたいと思います。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ