Excel VBA質問箱 IV

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

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


6637 / 13644 ツリー ←次へ | 前へ→

【44094】オートフィルタで抽出したデータをコピー 卓司 06/11/3(金) 20:03 質問[未読]
【44095】Re:オートフィルタで抽出したデータをコピー ponpon 06/11/3(金) 20:48 発言[未読]
【44097】Re:オートフィルタで抽出したデータをコピー 卓司 06/11/3(金) 22:11 お礼[未読]
【44098】Re:オートフィルタで抽出したデータをコピー ponpon 06/11/3(金) 22:39 発言[未読]
【44099】Re:オートフィルタで抽出したデータをコピー 卓司 06/11/3(金) 23:03 お礼[未読]

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

引用なし
パスワード
   皆様初めて投稿いたします。よろしくお願いします。
以下のコードを書きました。(作りかけ)

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は見出し項目(A1)以外ブランクにしておいて、使用者がコピー
したいデータの列Aに「1」を入力してもらい、Sheet2に切り替えるとデータが
張り付いているという動作をしたいのですが、
1.「1」がひとつも入力されていないと”対象データがありません”が表示
 され、かつすべてのデータがSheet2に張り付いてしまう。
2.「1」がいくつか入力されていても、セル「A2」がブランクだったり、「1」
 以外の数値がはいっていると、”対象データありません”になってしまう。

うまくいくのはセル「A2」に「1」が入っているときだけです。

IF文が問題だと思うのですが・・いろいろ調べてもわかりません。
どうかどうかよきアドバイスをお願いします。

【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は見出し項目(A1)以外ブランクにしておいて、使用者がコピー
>したいデータの列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

【44097】Re:オートフィルタで抽出したデータをコ...
お礼  卓司  - 06/11/3(金) 22:11 -

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

>で、こんな風にしてみました。
>
>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

ponponさん 
祝日なのにご回答ありがとうございます。
問題はかなり解決されましたが、これだと
1.列Aになにも何もはいっていない場合、(セルA2から下方向)
2.列Aに「1」以外の数値が入っている場合、(「2」とか「3」とかを間違って
入力した場合)
に”対象データがありません。”の表示がされません。
ponponさんのコードだと、どのような場合にメッセージ表示されるのでしょうか。
教えてください。よろしくお願いします。

【44098】Re:オートフィルタで抽出したデータをコ...
発言  ponpon  - 06/11/3(金) 22:39 -

引用なし
パスワード
   失礼しました。

>If .AutoFilter.Range.Columns(1).Rows.Count = 1 Then

If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then

に変更してください。

参考
h○○p://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=43239;id=excel

【44099】Re:オートフィルタで抽出したデータをコ...
お礼  卓司  - 06/11/3(金) 23:03 -

引用なし
パスワード
   ▼ponpon さん:
>失礼しました。
>
>>If .AutoFilter.Range.Columns(1).Rows.Count = 1 Then
>を
> If .AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
>
>に変更してください。
>
>参考
>h○○p://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=43239;id=excel

ponponさん
早速のご指導ありがとうございます。
大変、助かりました。

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