[[20220703053920]] 『resaizのメソッドrangeが失敗』(km) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『resaizのメソッドrangeが失敗』(km)

教えてください。

フィルターから絞り込んでsheet2へ転記するコードを書きましたが
元データーが全て無くなると デバッグになります
行全体を削除するメソッドなのでデーターが無いのに削除できないのではと思いましたが
対処法がわかりません よろしくお願いします
Sub km()

  Dim i As Long

  i = Sheets("sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
 Range(" a1").AutoFilter 1, "z", xlOr, " 255"
    With Range("A1").CurrentRegion.Offset(1, 0).Copy
    Sheets("sheet2").Range("a" & i).PasteSpecial
   End With
    With Range("A1").CurrentRegion.Offset(1, 0)
        .Resize(.Rows.Count - 1).EntireRow.Delete <-ここが反転します
    End With
    ActiveSheet.ShowAllData
 End Sub

< 使用 Excel:Excel2004(Mac)、使用 OS:MacOSX >


データが無いのにRange("A1").CurrentRegionねえ、
面倒くさいからエラートラップしたら。
(面倒卓) 2022/07/03(日) 06:57

(面倒卓)様 ありがとうございます
(km) 2022/07/03(日) 07:07

 該当データが無いとき、なぜか全データが対象になります。(そういう仕様のようです)
 こんな書き方で、該当データの有無を確認して、
 該当データがあるときだけ処理をするのが定石ですね。。

 Sub test()
     Dim i As Long
     Dim rng As Range

     With Worksheets("Sheet1")
         i = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row + 1
         .Range("A1").AutoFilter 1, "z", xlOr, " 255"

         Set rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
         If rng.Columns(1).Count > 1 Then
             'Sheet2にコピーペイスト
             .Range("A1").CurrentRegion.Offset(1, 0).Copy Sheets("Sheet2").Range("A" & i)
             '該当データを削除
             With .Range("A1").CurrentRegion.Offset(1, 0)
                 .Resize(.Rows.Count - 1).EntireRow.Delete
             End With
         End If
         .ShowAllData
     End With
 End Sub

 ちなみに、上記のようなActiveSheetに依存しない書き方を推奨します。

(γ) 2022/07/03(日) 07:18


 ついでに言えば、
     With Range("A1").CurrentRegion.Offset(1, 0).Copy
         Sheets("sheet2").Range("a" & i).PasteSpecial
     End With
 はおかしいですよね。

 With を使う必要はありません。
 (1)ドット(.)を使っていないので、首尾一貫していませんし、
 (2)
    Range("A1").CurrentRegion.Offset(1, 0).Copy は Trueを返すようです。
    (普通、返り値を使うことはないので、
        v  = Range("A1").CurrentRegion.Offset(1, 0).Copy
      と実験して、 True が返ることが判明しました。)

    ですから、あえて、あえて言えば、
     Range("A1").CurrentRegion.Offset(1, 0).Copy
     With True
         Sheets("sheet2").Range("a" & i).PasteSpecial
     End With
     と書いているようなものです。無駄なことです。

 With ステートメントの使い方も復習されたほうがいいですよ。
(γ) 2022/07/03(日) 07:35

(γ)様 ありがとうございます。

早速、コピペして動かしましたが、sheet2に転記されません
それと、抽出した"z"行も削除されていないので何がいけないのでしょうか?
(km) 2022/07/03(日) 07:50


ステップ実行というのをご存じですか?
F8キーを押して、一行ごとに実行していくものです。

それを実行して、
・オートフィルタで実行したものが、求めるものか
・それがコピーペイストされているか
をご自分の環境で確認してください。

こちらでは分かりません。(それが普通です。千里眼は持っていませんので。)

(γ) 2022/07/03(日) 08:14


(γ)様 ありがとうございます
やってみます
(km) 2022/07/03(日) 08:21

ああ、失礼しました。
        Set rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        If Intersect(rng, .Columns(1)).Count > 1 Then   'この行を修正
と修正してください。
(γ) 2022/07/03(日) 08:23

(γ)様 引き続きありがとうございます
無事、転記できました。
(km) 2022/07/03(日) 08:36

すみません もう一度教えてください。
(γ)様より教えていただいたコードで動かしていますが
複数のシートがある時 With Worksheets("Sheet1")の
sheet名をE1セルに書かれているシート名で変換して転記したいのですが
E1セルには、各シート名のリストを入れています
(km) 2022/07/03(日) 12:02

ループでシート名を回して
γさんのコードを呼び出せばいいかと
シート名を変数化して、シート名をパラメーターで受け渡しが、必要になりますが。
(隠居Z) 2022/07/03(日) 12:33

(隠居Z)様 ありがとうございます
なんとかできました。
(km) 2022/07/03(日) 13:02

度々すみません
If Intersect(rng, .Columns(1)).Count > 1 Then
この意味教えていただけませんか?
(km) 2022/07/03(日) 16:33

 (1)
 ・rngはオートフィルタかかっているセルの抽出されたデータ範囲(つまり可視セル)。
 ・そのA列だけを共通部分として取り出します。

 ・何も抽出されていなければ、見出し行のA列のセルだけだから、そのセルたちの個数は1です。
 ・なにかしら抽出されていれば、見出しも含めて2個以上のセルになります。
   その時(つまりなにかしらが抽出されている状態)だけ、転記と削除処理をすればよい訳です。

 (2)別の方法。
 もっとも、抽出したデータの個数を計算する式、例えば、
 =SUBTOTAL(3,A列のデータ範囲)
                ↑見出しを除く
 を一行目の余白にでも置いておき、
 これに基づいて、それが1以上の時に限って、
 転記、削除処理をさせるという手法もあります。
 このほうが簡単かもしれません。

(γ) 2022/07/03(日) 16:50


(γ)様 ありがとうございます。
おかげさまで、思った通りにできました。
(km) 2022/07/03(日) 20:05

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.