【アプリ版】サポートOS変更のお知らせ

"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


???部分の変数宣言と処理内容をどうすれば良いか、ご教授願えますでしょうか。

gooドクター

A 回答 (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


 
    • good
    • 5
この回答へのお礼

思い通りに動作しましたっ!すごいです。。。
この動作は一度だけになりますので、上の記述を参考にさせて頂きました。

Wendy02さんには前回にも回答頂き、ありがとうございます。
このところ作業を中断しておりましたが、前回の続きです。

全体イメージは見えてきましたので、あとは詳細の詰めとなっております。

お礼日時:2008/05/20 17:17

むつかしい記述になり過ぎていると思う。


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
    • good
    • 0
この回答へのお礼

ご教授ありがとうございます。
こんな方法もあったんですね。
VBAを記述する上で、自ら難しくしてしまっている感じです。

ゴール地点は同なのに到達する道筋が色々あって…奥深いですね。
参考に致します。

お礼日時:2008/05/20 16:57

こんばんは。



今回の内容の 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
    • good
    • 1

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

gooドクター

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング