Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

37804 / 76738

←次へ　｜　前へ→


	【44095】Re:オートフィルタで抽出したデータをコピー

ponpon - 06/11/3(金) 20:48 -


	引用なし

	パスワード

▼卓司さん：
>皆様初めて投稿いたします。よろしくお願いします。
>以下のコードを書きました。（作りかけ）
>
>Option Explicit
>Dim R As Range
>----------------------------------------------------------------------
>Private Sub Worksheet_Activate()
>
>　With Worksheets("Sheet1")
>　
>　.Range("A1").AutoFilter Field:=1, Criteria1:=1
>　
>　 If .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible) _
>　 .Rows.Count = 1 Then
>　 test3
>　 Else
>　 test2
>　 End If
>　
>　End With
>
>End Sub
>---------------------------------------------------------------------
>Private Sub test2()
>
>Set R = Worksheets("Sheet1").Range("A1").CurrentRegion
>　　With R
>　　　　　.Resize(.Rows.Count - 1).Offset(1).Copy
>　　　　　Worksheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
>
>　　End With
>　　
>R.AutoFilter
>　　
>End Sub
>----------------------------------------------------------------------
>Private Sub test3()
>
>　With Worksheets("Sheet1")
>　
>　MsgBox "対象データがありません。"
>　
>　.Activate
>　Selection.AutoFilter
>　
>　End With
>　
>End Sub
>
>Sheet1の列Aは見出し項目（A１）以外ブランクにしておいて、使用者がコピー
>したいデータの列Aに「1」を入力してもらい、Sheet2に切り替えるとデータが
>張り付いているという動作をしたいのですが、
>1.「1」がひとつも入力されていないと”対象データがありません”が表示
>　され、かつすべてのデータがSheet2に張り付いてしまう。

データがSheet2に張り付いてしまうのではなく、sheet1に戻るので、
そのように見えるのでは？

>2.「1」がいくつか入力されていても、セル「A2」がブランクだったり、「1」
>　以外の数値がはいっていると、”対象データありません”になってしまう。

Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
これが、誤動作の原因かな？？よくわかりませんが・・・
.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Select
とか
　 MsgBox .Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Address(0, 0)
なんかを入れると、エラーの原因がよくわかると思います。
私もよくやります。

>
>うまくいくのはセル「A2」に「1」が入っているときだけです。
>
>IF文が問題だと思うのですが・・いろいろ調べてもわかりません。
>どうかどうかよきアドバイスをお願いします。

で、こんな風にしてみました。

Option Explicit
Private Sub Worksheet_Activate()

　With Worksheets("Sheet1")
　　If .AutoFilterMode = False Then
　　　 .Range("A1").AutoFilter Field:=1, Criteria1:=1
　　End If
　　If .AutoFilter.Range.Columns(1).Rows.Count = 1 Then
　　　　MsgBox "対象データがありません。"
　　　 .AutoFilterMode = False
　　　 Exit Sub
　　Else
　　　 Sheets("Sheet2").Cells.ClearContents
　　　 .AutoFilter.Range.Offset(1).Copy
　　　 Sheets("Sheet2").Range("A1").PasteSpecial Paste:=xlPasteValues
　　　 .AutoFilterMode = False
　　　 Application.CutCopyMode = False
　　End If
　End With

End Sub

0 hits

▼

【44094】オートフィルタで抽出したデータをコピー 卓司 06/11/3(金) 20:03