Excel VBA質問箱 IV

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

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


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

【64550】オートフィルター使用での削除 MAX 10/2/23(火) 15:03 質問[未読]
【64551】Re:オートフィルター使用での削除 UO3 10/2/23(火) 15:36 回答[未読]
【64552】ありがとうございました。⇒Re:オートフィルター使... MAX 10/2/23(火) 15:44 お礼[未読]
【64553】Re:オートフィルター使用での削除 Yuki 10/2/23(火) 15:54 発言[未読]
【64554】ありがとうございます。⇒Re:オートフィルター使用... MAX 10/2/23(火) 16:01 お礼[未読]
【64555】Re:オートフィルター使用での削除 UO3 10/2/23(火) 16:14 発言[未読]
【64556】お気になさらないで⇒Re:オートフィルター使用での... MAX 10/2/23(火) 16:17 お礼[未読]
【64577】Re:オートフィルター使用での削除 UO3 10/2/24(水) 12:11 回答[未読]
【64580】Re:オートフィルター使用での削除 MAX 10/2/24(水) 12:21 お礼[未読]

【64550】オートフィルター使用での削除
質問  MAX  - 10/2/23(火) 15:03 -

引用なし
パスワード
   以下のようにN列で1のデータをオートフィルターで削除していますが、1がまったく無い場合は全て削除されてしまいます。回避方法をご教授願います。


  Sheets("WKデータ").Select
  Rows("3:3").Select
  Selection.AutoFilter                      'オートフィルターセット
'
  Range("A4").Select                       'A列項目の下
  Range(Selection, Selection.End(xlDown)).Select
  Range(Selection, Selection.End(xlToRight)).Select
  Selection.AutoFilter Field:=14, Criteria1:="1"         'オートフィルターの場所:Nと削除ビット:1
  Selection.EntireRow.Delete
  Selection.AutoFilter Field:=14                 'オートフィルターの場所:N
'
  Rows("3:3").Select
  Selection.AutoFilter                      'オートフィルター解除

【64551】Re:オートフィルター使用での削除
回答  UO3  - 10/2/23(火) 15:36 -

引用なし
パスワード
   ▼MAX さん:
こんにちは。
オートフィルターの抽出結果の行数は以下で把握できます。
ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count

【64552】ありがとうございました。⇒Re:オートフィルター...
お礼  MAX  - 10/2/23(火) 15:44 -

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

ありがとうございました。
早速、組込んでテストして見ます。

>▼MAX さん:
>こんにちは。
>オートフィルターの抽出結果の行数は以下で把握できます。
>ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count

【64553】Re:オートフィルター使用での削除
発言  Yuki  - 10/2/23(火) 15:54 -

引用なし
パスワード
   ▼MAX さん:
>以下のようにN列で1のデータをオートフィルターで削除していますが、1がまったく無い場合は全て削除されてしまいます。回避方法をご教授願います。

こんにちは。こんな感じで

With Worksheets("WKデータ")
  .AutoFilterMode = False
  With .Range("A1").CurrentRegion
    With .Offset(3).Resize(.Rows.Count - 3)
      .AutoFilter Field:=14, Criteria1:="1"
      If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 _
      Or .SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
      End If
    End With
  End With
  .AutoFilterMode = False
End With

【64554】ありがとうございます。⇒Re:オートフィルター使...
お礼  MAX  - 10/2/23(火) 16:01 -

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

ありがとうございます。
SpecialCells(xlCellTypeVisible).Rows.Count
の使い方が良く判っていませんでした。
私には難しいコードですが勉強します。


>▼MAX さん:
>>以下のようにN列で1のデータをオートフィルターで削除していますが、1がまったく無い場合は全て削除されてしまいます。回避方法をご教授願います。
>
>こんにちは。こんな感じで
>
>With Worksheets("WKデータ")
>  .AutoFilterMode = False
>  With .Range("A1").CurrentRegion
>    With .Offset(3).Resize(.Rows.Count - 3)
>      .AutoFilter Field:=14, Criteria1:="1"
>      If .SpecialCells(xlCellTypeVisible).Rows.Count > 1 _
>      Or .SpecialCells(xlCellTypeVisible).Areas.Count > 1 Then
>        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
>      End If
>    End With
>  End With
>  .AutoFilterMode = False
>End With

【64555】Re:オートフィルター使用での削除
発言  UO3  - 10/2/23(火) 16:14 -

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

お伝えしたコード、あわてましたので不正確です。
yukiさんの模範解答をお使いください。

【64556】お気になさらないで⇒Re:オートフィルター使用で...
お礼  MAX  - 10/2/23(火) 16:17 -

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

早速ありがとうございます。
お気になさらないでください。


>▼MAX さん:
>
>お伝えしたコード、あわてましたので不正確です。
>yukiさんの模範解答をお使いください。

【64577】Re:オートフィルター使用での削除
回答  UO3  - 10/2/24(水) 12:11 -

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

先日はあわてて不正確なものをアップして申し訳ありませんでした。
すでに解決しておられるとは思いますが、抽出結果の削除の1つの例として。

Sub 削除実行()
Dim rr As Range

 If LineCount = 0 Then
  MsgBox "削除すべき抽出結果がありません"
  Exit Sub
 End If
 
 Set rr = Range("A1").CurrentRegion
 rr.Offset(1, 0).Resize(rr.Rows.Count - 1, rr.Columns.Count).EntireRow.Delete
 
End Sub

Function LineCount() As Long
Dim rr As Range
Dim x As Long
Dim myArea As Range
Dim ans As Long

 Set rr = ActiveSheet.AutoFilter.Range
 Set rr = Intersect(rr, rr.Offset(1))
 
 If rr Is Nothing Then Exit Function

 Set rr = rr.Columns(1)
 On Error GoTo bye
 Set rr = rr.SpecialCells(xlCellTypeVisible)
 
 For Each myArea In rr.Areas
   ans = ans + myArea.Rows.Count
 Next
 
 LineCount = ans
bye:
End Function

【64580】Re:オートフィルター使用での削除
お礼  MAX  - 10/2/24(水) 12:21 -

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

お忙しいところをありがとうございます。
UO3さんのコードも試してみます。
勉強になりました。


>▼MAX さん:
>
>先日はあわてて不正確なものをアップして申し訳ありませんでした。
>すでに解決しておられるとは思いますが、抽出結果の削除の1つの例として。
>
>Sub 削除実行()
>Dim rr As Range
>
> If LineCount = 0 Then
>  MsgBox "削除すべき抽出結果がありません"
>  Exit Sub
> End If
> 
> Set rr = Range("A1").CurrentRegion
> rr.Offset(1, 0).Resize(rr.Rows.Count - 1, rr.Columns.Count).EntireRow.Delete
> 
>End Sub
>
>Function LineCount() As Long
>Dim rr As Range
>Dim x As Long
>Dim myArea As Range
>Dim ans As Long
>
> Set rr = ActiveSheet.AutoFilter.Range
> Set rr = Intersect(rr, rr.Offset(1))
> 
> If rr Is Nothing Then Exit Function
>
> Set rr = rr.Columns(1)
> On Error GoTo bye
> Set rr = rr.SpecialCells(xlCellTypeVisible)
> 
> For Each myArea In rr.Areas
>   ans = ans + myArea.Rows.Count
> Next
> 
> LineCount = ans
>bye:
>End Function

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