"Sheet1"のA列に区分(文字列)、B列~D列に分析数値があり
A列の文字が条件に一致した行のデータを"Sheet2"にコピー、
元の"Sheet1"のデータは行ごと削除といった形で考えているのですが、どうも上手くいきません。
Dim Keywrd As String
???
With Worksheets("Sheet1").Columns("A:A")
Set Keywrd = .Find("キーワード", LookIn:=xlValues)
???
End With
Set Keywrd = Nothing
TargetCell.EntireRow.Select
Selection.Delete Shift:=xlUp
End Sub
???部分の変数宣言と処理内容をどうすれば良いか、ご教授願えますでしょうか。
No.3ベストアンサー
- 回答日時:
こんばんは。
#1の回答者です。一度きりなら、こんな風に直してみたらよいと思います。質問のコードは、変数の流れがおかしくなっているようです。
Sub Macro1()
Dim Keywrd As String
Dim TargetCell As Range
Keywrd = InputBox("キーワードを入れてください", "キーワード入力")
If Keywrd = "" Then Exit Sub
With Worksheets("Sheet1").Columns("A:A")
Set TargetCell = .Find(Keywrd, LookAt:=xlWhole, LookIn:=xlValues)
If TargetCell Is Nothing Then
MsgBox Keywrd & " は見つかりません。"
Exit Sub
End If
End With
'Keywrd = "" ''不要
TargetCell.EntireRow.Copy Worksheets("Sheet2").Range("A1")
TargetCell.Delete Shift:=xlUp
End Sub
--------------------------------------
#1 のコードを考え直し修正しました。
私のコードは、必ず、検索値に対して複数、該当するものがあるという条件になっています。
---------------------------------------------
Sub TestFind2()
Dim myKeyWord As String
Dim FirstAdd As String
Dim c As Range
Dim ur As Range
myKeyWord = Application.InputBox("検索文字を入れてください", "検索+移動", Type:=2)
If myKeyWord = "" Or myKeyWord = "False" Then Exit Sub
With Worksheets("Sheet1").Columns(1)
.Cells(1).Select
Set c = .Find( _
What:=myKeyWord, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False, _
MatchByte:=True)
If Not c Is Nothing Then
Set ur = c.EntireRow
FirstAdd = c.Address
Do
Set ur = Union(c.EntireRow, ur)
Set c = .FindNext(c)
Loop Until (c Is Nothing) Or (FirstAdd = c.Address)
End If
ur.Copy Worksheets("Sheet2").Range("A1")
ur.Delete Shift:=xlShiftUp
End With
Set ur = Nothing
End Sub
思い通りに動作しましたっ!すごいです。。。
この動作は一度だけになりますので、上の記述を参考にさせて頂きました。
Wendy02さんには前回にも回答頂き、ありがとうございます。
このところ作業を中断しておりましたが、前回の続きです。
全体イメージは見えてきましたので、あとは詳細の詰めとなっております。
No.2
- 回答日時:
むつかしい記述になり過ぎていると思う。
FindメソッドはFindNextメソッドなどアリ、初心者にはむつかしい。
別途単純な方法(総当り法)でやってみる。
小生にとって馬鹿の1つ覚えのような方法だが
Sheet1のA列のaの行をSheet2へ抜き出すには
(下記では i は処理対象行ポインタ、K は書き出し行ポインタ)
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
k = 2
i = 2
Do While Cells(i, "A") <> ""
If sh1.Cells(i, "A") = "a" Then
sh2.Cells(k, "A") = sh1.Cells(i, "A")
sh2.Cells(k, "B") = sh1.Cells(i, "B")
sh1.Rows(i).Delete
k = k + 1
Else
i = i + 1
End If
Loop
End Sub
例データ
Sheet1 スタート状態
A1:B9
区分計数
a3
b5
a2
b3
c1
c2
a6
a7
Sheet2 A2:B5
a3
a2
a6
a7
Sheet1 結果
区分計数
b5
b3
c1
c2
ご教授ありがとうございます。
こんな方法もあったんですね。
VBAを記述する上で、自ら難しくしてしまっている感じです。
ゴール地点は同なのに到達する道筋が色々あって…奥深いですね。
参考に致します。
No.1
- 回答日時:
こんばんは。
今回の内容の Find メソッドからでは、かなりむつかしいです。それと、Find メソッドの引数を省略するのが良く分からないです。確か、ワークシート側の検索置換にひきずられてしまったような気がします。
------------------------------------------
Sub TestFind()
Dim myKeyWord As String
Dim c As Range
Dim r As Range
Dim i As Long
myKeyWord = Application.InputBox("検索文字を入れてください", "検索+移動", Type:=2)
If myKeyWord = "" Or myKeyWord = "False" Then Exit Sub
With Worksheets("Sheet1").Columns(1)
.Cells(1).Select
Set c = .Find( _
What:=myKeyWord, _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False, _
MatchByte:=True)
If Not c Is Nothing Then
Do
If Not r Is Nothing Then
r.Delete
Set r = Nothing
End If
On Error Resume Next
'削除すると、オブジェクトを失い、エラーが発生する
c.EntireRow.Copy Worksheets("Sheet2").Range("A1").Offset(i)
If Err.Number > 0 Then Exit Do
On Error GoTo 0
Set r = c.EntireRow
Set c = .FindNext(c)
i = i + 1
Loop
End If
End With
End Sub
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 3つのプロシージャをまとめたら実行時エラー発生で対応不能 6 2022/05/17 01:47
- Visual Basic(VBA) 2つのシートの任意のセルの番号が一致したら、一致した行をコピーする VBA 2 2023/06/19 20:48
- Visual Basic(VBA) まとめシートから集計シートへA列のコードが一致したら1行コピーするマクロをネット上で見つけました。こ 1 2022/08/30 14:11
- Visual Basic(VBA) 【前回の続き続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/24 20:49
- Visual Basic(VBA) vbaを早くしたい 5 2022/09/09 10:58
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- その他(Microsoft Office) マクロVBAについて 1 2022/09/06 18:12
- Visual Basic(VBA) エクセルVBAのコードで質問です。 下のコードはJ16の文字列をB3を起点とする範囲から探して、見つ 5 2023/04/07 11:07
- Visual Basic(VBA) エクセル VBA 処理スピードを上げたいのですが。 6 2023/03/31 20:52
このQ&Aを見た人はこんなQ&Aも見ています
-
性格の違いは生まれた順番で決まる?長男長女・中間子・末っ子・一人っ子の性格の傾向
同じ環境で生まれ育っても、生まれ順で性格は違うものなのだろうか。家庭教育研究家の田宮由美さんに教えてもらった。
-
条件にマッチする行を抽出するVBAを教えてください
経営情報システム
-
vba 2つの条件が一致したらコピーして別シートに値のみ貼り付け
Visual Basic(VBA)
-
VBA 値と一致した行の一部の列のデータを転記について教えてください
Visual Basic(VBA)
-
-
4
【VBA】特定の値が入った行をコピーして別シートに貼り付ける方法をおしえていただきたいです。
Excel(エクセル)
-
5
エクセルVBAで、ある文字を含んでいたら別シートに抽出したい
Excel(エクセル)
-
6
エクセルVBAで、条件に一致するセルへ移動
Excel(エクセル)
-
7
VBAで条件が一致する行をコピーしその1つ下へ挿入
Excel(エクセル)
-
8
VBA Cのセルが空白でなかったら、Aのセルに順番に数値を入力
Visual Basic(VBA)
-
9
【VBA】指定した検索条件に一致したら別シートに転記したい
Visual Basic(VBA)
-
10
WorkBooksをオープンさせずにシートにコピーしたい【EXCEL VBA】
Excel(エクセル)
-
11
EXCEL VBAで全選択範囲の解除
Excel(エクセル)
-
12
特定の文字がある行以外を削除するマクロ
その他(Microsoft Office)
-
13
VBA for i=1 to lastrow
Excel(エクセル)
-
14
VBAで別ブックの列を検索し、該当があれば行ごと新規ブックにコピーしたい。
Excel(エクセル)
-
15
【VBA】特定の文字が入っている行の一部を抽出して別シートコピーするには
Visual Basic(VBA)
-
16
VBAで繰り返しコピーしながら下へ移動させる方法
Excel(エクセル)
-
17
特定のセルが空白だったら、その行を非表示にしたい。。。
Visual Basic(VBA)
-
18
複数シートの色付きセルがある行を別シートに抽出
Excel(エクセル)
-
19
複数のセルをコピーし、別シートの任意のセルへペーストをするためのマクロ
Excel(エクセル)
-
20
マクロで条件に合った行の選択について
Excel(エクセル)
関連するカテゴリからQ&Aを探す
このQ&Aを見た人がよく見るQ&A
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel で行を指定回数だけコピ...
-
excelの差込印刷で可視セルだけ...
-
VBA別シートの最終行の下行へ貼...
-
VBA:同じ文字列データの比...
-
VBAの指示の内容 昨日こちらで...
-
エクセルVBA 別シートの複数の...
-
VBAで条件が一致する行のデータ...
-
Excelマクロ データが上書きさ...
-
【VBA】UserForm1の中で使うワ...
-
excel:色付き文字の抽出と変換法
-
Excel VBA インデックスの境...
-
Excel VBA 複数条件にマッチし...
-
エクセルVBAについて
-
エクセル シート保護後コメン...
-
エクセルVBAで SendKeys "{TAB}"
-
スマホで古いPCにテザリング
-
VBAで抽出とコピペのループがう...
-
Excel VBAでシート内全体に非表...
-
携帯修理出して戻ってきたら、L...
-
携帯に保存の画像をパソコンへ...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excel で行を指定回数だけコピ...
-
エクセルVBA 別シートの複数の...
-
excelの差込印刷で可視セルだけ...
-
Excel VBA インデックスの境...
-
シャープのアクオス sh-m25 を...
-
VBA:同じ文字列データの比...
-
エクセル:VBAで月変わりで、自...
-
VBA別シートの最終行の下行へ貼...
-
エクセルVBAで 2種のリストを...
-
エクセルVBAで SendKeys "{TAB}"
-
VBAで条件が一致する行のデータ...
-
Excel VBAでシート内全体に非表...
-
歯抜けの時間を埋めて行の挿入
-
Excelマクロ データが上書きさ...
-
VBA 貼付先範囲(行)がいっぱ...
-
【WORD差し込み印刷】複数レコ...
-
EXCELマクロで全シート対...
-
エクセルVBAでの日付順のデ...
-
エクセル シート保護後コメン...
-
ノートパソコン 2in1について i...
おすすめ情報