Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3052 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【64550】ｵｰﾄﾌｨﾙﾀｰ使用での削除 ＭＡＸ 10/2/23(火) 15:03 質問[未読]
【64551】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除 UO3 10/2/23(火) 15:36 回答[未読]
【64552】ありがとうございました。⇒Re:ｵｰﾄﾌｨﾙﾀｰ使... ＭＡＸ 10/2/23(火) 15:44 お礼[未読]
【64553】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除 Yuki 10/2/23(火) 15:54 発言[未読]
【64554】ありがとうございます。⇒Re:ｵｰﾄﾌｨﾙﾀｰ使用... ＭＡＸ 10/2/23(火) 16:01 お礼[未読]
【64555】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除 UO3 10/2/23(火) 16:14 発言[未読]
【64556】お気になさらないで⇒Re:ｵｰﾄﾌｨﾙﾀｰ使用での... ＭＡＸ 10/2/23(火) 16:17 お礼[未読]
【64577】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除 UO3 10/2/24(水) 12:11 回答[未読]
【64580】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除 ＭＡＸ 10/2/24(水) 12:21 お礼[未読]
【64550】ｵｰﾄﾌｨﾙﾀｰ使用での削除
質問  ＭＡＸ  - 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 -
引用なし
パスワード
   ▼ＭＡＸ さん：
こんにちは。
オートフィルターの抽出結果の行数は以下で把握できます。
ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count
【64552】ありがとうございました。⇒Re:ｵｰﾄﾌｨﾙﾀｰ...
お礼  ＭＡＸ  - 10/2/23(火) 15:44 -
引用なし
パスワード
   ▼UO3 さん：

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

>▼ＭＡＸ さん：
>こんにちは。
>オートフィルターの抽出結果の行数は以下で把握できます。
>ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows.Count
【64553】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除
発言  Yuki  - 10/2/23(火) 15:54 -
引用なし
パスワード
   ▼ＭＡＸ さん：
>以下のように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:ｵｰﾄﾌｨﾙﾀｰ使...
お礼  ＭＡＸ  - 10/2/23(火) 16:01 -
引用なし
パスワード
   ▼Yuki さん：

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


>▼ＭＡＸ さん：
>>以下のように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 -
引用なし
パスワード
   ▼ＭＡＸ さん：

お伝えしたコード、あわてましたので不正確です。
yukiさんの模範解答をお使いください。
【64556】お気になさらないで⇒Re:ｵｰﾄﾌｨﾙﾀｰ使用で...
お礼  ＭＡＸ  - 10/2/23(火) 16:17 -
引用なし
パスワード
   ▼UO3 さん：

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


>▼ＭＡＸ さん：
>
>お伝えしたコード、あわてましたので不正確です。
>yukiさんの模範解答をお使いください。
【64577】Re:ｵｰﾄﾌｨﾙﾀｰ使用での削除
回答  UO3  - 10/2/24(水) 12:11 -
引用なし
パスワード
   ▼ＭＡＸ さん：

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

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:ｵｰﾄﾌｨﾙﾀｰ使用での削除
お礼  ＭＡＸ  - 10/2/24(水) 12:21 -
引用なし
パスワード
   ▼UO3 さん：

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


>▼ＭＡＸ さん：
>
>先日はあわてて不正確なものをアップして申し訳ありませんでした。
>すでに解決しておられるとは思いますが、抽出結果の削除の１つの例として。
>
>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
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3052 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free