|
▼卓司 さん:
>皆様初めて投稿いたします。よろしくお願いします。
>以下のコードを書きました。(作りかけ)
>
>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
|
|