Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


1685 / 13646 ツリー ←次へ | 前へ→

【72645】検索値以外を全て削除したい はってんちゅう 12/8/30(木) 15:26 質問[未読]
【72647】Re:検索値以外を全て削除したい UO3 12/8/30(木) 15:49 発言[未読]
【72648】Re:検索値以外を全て削除したい ドカ 12/8/30(木) 16:29 回答[未読]
【72649】Re:検索値以外を全て削除したい はってんちゅう 12/8/30(木) 17:07 質問[未読]
【72650】Re:検索値以外を全て削除したい UO3 12/8/30(木) 17:26 発言[未読]
【72652】Re:検索値以外を全て削除したい はってんちゅう 12/8/30(木) 20:02 お礼[未読]
【72651】Re:検索値以外を全て削除したい ドカ 12/8/30(木) 17:46 発言[未読]
【72653】Re:検索値以外を全て削除したい はってんちゅう 12/8/30(木) 20:14 お礼[未読]

【72645】検索値以外を全て削除したい
質問  はってんちゅう  - 12/8/30(木) 15:26 -

引用なし
パスワード
   検索&削除のモジュールに関してです。

先日、UO3さんから検索対象の削除モジュールでアドバイスを頂き
無事解決したのですが、今度は検索対象以外のものすべてを削除するモジュールを
書いています。

以下がそれです。
コラムA にある科目名を頼りに“投資”以外の科目の行を全て削除させる目的です。10行目から科目が入るRowになります。

  Range("A10").Select
  m = 10
  Do Until Range("A" & m) = ""
    If Not Range("A" & m) = "投資" Then
      Rows(m).Delete
    End If
      m = m + 1
  Loop

50行ほどあるのですが、これだと、全削除されずにかなり残ってしまいます。
なんとなくそうなるダメな理由が解るような気がするものの、どうしていいのかが
解りません。

以下は、検索対象を削除するモジュールですが、これの反対(検索対象以外を削除)版を行いたいわけです。

Dim cNo As Range
Dim myR As Range
Dim firstaddress As String

  With Worksheets(2).Range("A9:AZ9")
    Set cNo = .Find("投資", LookIn:=xlValues, SearchOrder:=xlByRows)
  
    If Not cNo Is Nothing Then
      firstaddress = cNo.Address
      Do
        If myR Is Nothing Then
          Set myR = cNo
        Else
          Set myR = Union(myR, cNo)
        End If
    
        Set cNo = .FindNext(cNo)
    
      Loop While cNo.Address <> firstaddress
   
    End If
  
    If Not myR Is Nothing Then myR.EntireRow.Delete
  
  End With


これを上手く活用する事も出来るのでしょうが、上手くいきません。

どうぞご教示いただけますでしょうか。
宜しくお願い致します。

【72647】Re:検索値以外を全て削除したい
発言  UO3  - 12/8/30(木) 15:49 -

引用なし
パスワード
   ▼はってんちゅう さん:

▼はってんちゅう さん:

こんにちは

姑息な(?)手段としては、
・抽出された状態で、コピーしてこのシートのリスト領域の右側にペースト。
・その上で、現在のリスト領域の列を削除。

これでもいいのかなと思います。

まっとうにコード処理するとすれば以下はサンプルです。
Sheet1にオートフィルターを設定して、何か、抽出された形にして実行してみてください。

Sub Sample()
  'オートフィルターで抽出されていない行を削除する
  Dim c As Range
  Dim r As Range
  
  For Each c In Sheets("Sheet1").AutoFilter.Range.Columns(1).Cells
    If Intersect(c, Sheets("Sheet1").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)) Is Nothing Then
      If r Is Nothing Then
        Set r = c
      Else
        Set r = Union(r, c)
      End If
    End If
  Next
  
  If Sheets("Sheet1").FilterMode Then Sheets("Sheet1").ShowAllData
  If Not r Is Nothing Then r.EntireRow.Delete
  
End Sub

【72648】Re:検索値以外を全て削除したい
回答  ドカ  - 12/8/30(木) 16:29 -

引用なし
パスワード
   ▼はってんちゅう さん:
Sub test1()

For i = 100 To 10 Step -1
  If Cells(i, 1) = "投資" Then
  Else
    Rows(i).Delete
  End If
Next
End Sub

【72649】Re:検索値以外を全て削除したい
質問  はってんちゅう  - 12/8/30(木) 17:07 -

引用なし
パスワード
   ▼ドカ さん:

ありがとうございます。

ついでで申し訳ないのですが、
検索Findを使用するときの指定要因で、検索用語が完全一致であることを指定するには、どういう文言が必要なのでしょうか。調べても見つからず困っています。

教えていただけますでしょうか。

以下は、“当期純損益金額”という言葉のある行の2行下にコピーしているものを
貼り付ける事を書いたものです。
他にもこの言葉が入った用語があり、現在のモジュールはそれを選択してしまっています。
言葉の完全一致を指定したいです。

  Range("A10").Select  '投資残の表を損益外貨表の下に貼り付け
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.Copy
  Sheets(2).Select
  With Worksheets(2).Range("a10:a50")
    Set u = .Find("当期純損益金額", LookAt:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=True)
  firstaddress = u.Address
  Range("A" & u.Row + 2).Select
  ActiveSheet.Paste
  End With

宜しくお願い致します。

【72650】Re:検索値以外を全て削除したい
発言  UO3  - 12/8/30(木) 17:26 -

引用なし
パスワード
   ▼はってんちゅう さん:

こんにちは

>検索Findを使用するときの指定要因で、検索用語が完全一致であることを指定するには、どういう文言が必要なのでしょうか。

LookAt:=xlPart ---> LookAt:=xlWhole

ですね。

【72651】Re:検索値以外を全て削除したい
発言  ドカ  - 12/8/30(木) 17:46 -

引用なし
パスワード
   ▼はってんちゅう さん
私なんか何も知りませんが、ネットで ”VBA find” で検索すれば、最初に答えが出てきますよ。

【72652】Re:検索値以外を全て削除したい
お礼  はってんちゅう  - 12/8/30(木) 20:02 -

引用なし
パスワード
   ▼UO3 さん:

また助けていただいてありがとうございます!

【72653】Re:検索値以外を全て削除したい
お礼  はってんちゅう  - 12/8/30(木) 20:14 -

引用なし
パスワード
   ▼ドカ さん:

ありがとうございます。もう一度見てみます。

1685 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free