Excel VBA質問箱 IV

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

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


7707 / 13645 ツリー ←次へ | 前へ→

【37345】オートフィルタの結果がもし空白なら momo 06/5/1(月) 13:33 質問[未読]
【37348】Re:オートフィルタの結果がもし空白なら ハチ 06/5/1(月) 13:47 回答[未読]
【37350】Re:オートフィルタの結果がもし空白なら momo 06/5/1(月) 14:44 質問[未読]
【37352】Re:オートフィルタの結果がもし空白なら ハチ 06/5/1(月) 15:33 発言[未読]
【37355】Re:オートフィルタの結果がもし空白なら Jaka 06/5/1(月) 16:16 発言[未読]
【37364】Re:オートフィルタの結果がもし空白なら momo 06/5/1(月) 17:57 質問[未読]
【37366】Re:オートフィルタの結果がもし空白なら Kein 06/5/1(月) 18:21 発言[未読]
【37376】Re:オートフィルタの結果がもし空白なら momo 06/5/2(火) 9:29 質問[未読]
【37377】Re:オートフィルタの結果がもし空白なら Jaka 06/5/2(火) 11:16 発言[未読]
【37379】追加 Jaka 06/5/2(火) 13:21 発言[未読]
【37380】Re:追加 momo 06/5/2(火) 14:27 お礼[未読]
【37381】Re:追加 Jaka 06/5/2(火) 15:30 発言[未読]
【37351】Re:オートフィルタの結果がもし空白なら Kein 06/5/1(月) 15:13 回答[未読]

【37345】オートフィルタの結果がもし空白なら
質問  momo  - 06/5/1(月) 13:33 -

引用なし
パスワード
   3つのシートにオートフィルタをかけて、2行目以降が空白なら次の処理に進むというコードを別のブックからさせているのですが、IF文の所でエラーがでてしまいます。
Dim C As Range
 For Each C In Range("A2", Range("A65536").End(xlUp))
   If C.Value <> "" Then _
 GoTo 処理
これを3つのワークシートをオープンさせ、オートフィルタをかけた後に書くと、
Forで指定された変数は既に使用されています。
とでて、
If WorksheetFunction.CountA(Range("A2:A65536")) = 0 Then
と書くと、空白でも実行されてしまい、
If WorksheetFunction.CountA(Range("A2:A65536")).Value <> "" Then
と書くと修飾子が不正となってしまうのですが、どこが間違っているのでしょうか?

【37348】Re:オートフィルタの結果がもし空白なら
回答  ハチ  - 06/5/1(月) 13:47 -

引用なし
パスワード
   >If WorksheetFunction.CountA(Range("A2:A65536")) = 0 Then

If WorksheetFunction.CountA(Range("A2:A65536") _
.SpecialCells(xlCellTypeVisible)) = 0 Then

では?可視セルにするべきかと。

【37350】Re:オートフィルタの結果がもし空白なら
質問  momo  - 06/5/1(月) 14:44 -

引用なし
パスワード
   ▼ハチ さん:
>>If WorksheetFunction.CountA(Range("A2:A65536")) = 0 Then
>
>If WorksheetFunction.CountA(Range("A2:A65536") _
>.SpecialCells(xlCellTypeVisible)) = 0 Then
>
>では?可視セルにするべきかと。

ハチさん
ありがとうございます。
可視セルにしましたが、タイトル行(A1行)が転記されてしまいます。
0が間違っているのでしょうか?

【37351】Re:オートフィルタの結果がもし空白なら
回答  Kein  - 06/5/1(月) 15:13 -

引用なし
パスワード
   >3つのシートにオートフィルタをかけて、2行目以降が空白なら次の処理に進む

Dim WB As Workbook
Dim WS As Worksheet

Set WB = Workbooks("Book1.xls")
Application.ScreenUpdating = False 
For Each WS In WB.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
  WS.Range("A1").CurrentRegion.AutoFilter 1, "Test"
  If WS.AutoFilter.Range.Columns(1).SpecialCells(12).Count > 1 Then
   フィルターの結果は抽出件数 1 以上なので、何かの処理をここへ書く
  End If
  WS.AutoFilterMode = False
Next
Application.ScreenUpdating = True: Set WB = Nothing

・・こんな感じで出来ます。

【37352】Re:オートフィルタの結果がもし空白なら
発言  ハチ  - 06/5/1(月) 15:33 -

引用なし
パスワード
   ▼momo さん:
>▼ハチ さん:
>>>If WorksheetFunction.CountA(Range("A2:A65536")) = 0 Then
>>
>>If WorksheetFunction.CountA(Range("A2:A65536") _
>>.SpecialCells(xlCellTypeVisible)) = 0 Then
>>
>>では?可視セルにするべきかと。
>
>ハチさん
>ありがとうございます。
>可視セルにしましたが、タイトル行(A1行)が転記されてしまいます。
>0が間違っているのでしょうか?

判定結果はA2〜A655336が非表示になっている状態なら合っていると思いますよ。
その後のコピー処理が間違っているのでは?
この式の直前に・・・
Msgbox WorksheetFunction.CountA(Range("A2:A65536") _
.SpecialCells(xlCellTypeVisible))

と入れてみてはいかがでしょ?

【37355】Re:オートフィルタの結果がもし空白なら
発言  Jaka  - 06/5/1(月) 16:16 -

引用なし
パスワード
   ▼momo さん:
>可視セルにしましたが、タイトル行(A1行)が転記されてしまいます。
多分これじゃないかと
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=87;id=FAQ

【37364】Re:オートフィルタの結果がもし空白なら
質問  momo  - 06/5/1(月) 17:57 -

引用なし
パスワード
   ハチさん
Msgbox WorksheetFunction.CountA(Range("A2:A65536") _
.SpecialCells(xlCellTypeVisible))

を記述してみると、可視セルのデータ件数は表示されないのにやはりタイトル行が転記されてしまいました。


IFの前後のコードは

Sub テスト()
Dim WS1 As Worksheet
Dim wb1 As Worksheet
Set WS1 = Sheet(1)
Set wb1 = Sheet(2)


ar = WS1.Range("A65536").End(xlUp).Row
With WS1
  .AutoFilterMode = 0
  .Range("A2:A" & ar).CurrentRegion.AutoFilter 5, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2007/12/31"
  End With

※Ifはここに入っています。

   If WorksheetFunction.CountA(Range("A2:A65536") _
   .SpecialCells(xlCellTypeVisible)) = 0 Then

 GoTo 処理
  End If

With WS1.Range("A2", WS1.Range("A65536").End(xlUp)) _
            .SpecialCells(xlCellTypeVisible)

WS1.AutoFilter.Range.SpecialCells (xlCellTypeVisible)
.Offset(,1).Copy
wb1.Range("A2").Offset(, -3).PasteSpecial Paste:=xlValues

End With



以下3つのシートでコピーペーストのコードを記載

Keinさん
>>3つのシートにオートフィルタをかけて、2行目以降が空白なら次の処理に進む
>
>Dim WB As Workbook
>Dim WS As Worksheet
>
>Set WB = Workbooks("Book1.xls")
>Application.ScreenUpdating = False 
>For Each WS In WB.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
>  WS.Range("A1").CurrentRegion.AutoFilter 1, "Test"
>  If WS.AutoFilter.Range.Columns(1).SpecialCells(12).Count > 1 Then
>   フィルターの結果は抽出件数 1 以上なので、何かの処理をここへ書く
>  End If
>  WS.AutoFilterMode = False
>Next
>Application.ScreenUpdating = True: Set WB = Nothing
>

For Nextを使わずに処理を実行したい場合はどうしたらいいのでしょうか?
次の処理に進むというのを3回程繰り返すので、For Nextを使わない方法をとりたいのですが・・。
ちなみに

>  If WS.AutoFilter.Range.Columns(1).SpecialCells(12).Count > 1 Then
を実行したところ、データがあるシートの転記がされなくなりました。


データが空白というよりは、データが無い場合の条件振り分けなので、
試しにIF文を削除して実行してみたところ、エラーにならず、IF文を削除しても1行目のデータが転記されてしまいました。

【37366】Re:オートフィルタの結果がもし空白なら
発言  Kein  - 06/5/1(月) 18:21 -

引用なし
パスワード
   >次の処理
とは何なのか、説明しないと分かりません。3つのシートで連続してフィルター
をかける、とだけ書かれていたら誰でも「次のシートに移ること」と解釈しますよ。

【37376】Re:オートフィルタの結果がもし空白なら
質問  momo  - 06/5/2(火) 9:29 -

引用なし
パスワード
   ▼Kein さん:
>>次の処理
>とは何なのか、説明しないと分かりません。3つのシートで連続してフィルター
>をかける、とだけ書かれていたら誰でも「次のシートに移ること」と解釈しますよ。

説明不足で申し訳ありません。
次の処理とは、確かに次のシートに移ることなのですが、各シートでオートフィルタをかけて、コピーペーストをし、データがなければ、次のシートに移りオートフィルタをかけてコピーペーストをする。を繰り返しています。
但し、フィルタ条件が各シート異なり、コピーペースト範囲も違うので、LOOPは使わずに1シートずつさせています。

少々長くなりますが、以下に処理コードを記述しますね。

Sub テスト()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim wb1 As Worksheet
Dim wb2 As Worksheet
Dim WB As Workbook

Set WS1 = Sheet(1)
Set WS2 = Sheet(2)
Set WS3 = Sheet(3)

Set WB = Workbooks.Open(Filename:="C:\****\****\sanmple.xls")
Set wb1 = WB.Sheets("サンプル")

'シート1の最終行を取得
ar = WS1.Range("A65536").End(xlUp).Row

'シート1を5列目に抽出条件を1月1日〜12月31日目までと設定してオートフィルタを設定する。

With WS1
  .AutoFilterMode = 0
  .Range("A2:A" & ar).CurrentRegion.AutoFilter 5, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2007/12/31"
  End With
'もし、2列目以降が空白なら、処理に進む
  If WorksheetFunction.CountA(Range("A2:A65536") _
  .SpecialCells(xlCellTypeVisible)) = 0 Then

 GoTo 処理
  End If
'可視セルの最終行までを選択
With WS1.Range("A2", WS1.Range("A65536").End(xlUp)) _
            .SpecialCells(xlCellTypeVisible)

WS1.AutoFilter.Range.SpecialCells (xlCellTypeVisible)
.Offset(,1).Copy
wb1.Range("A2").Offset(, -3).PasteSpecial Paste:=xlValues
      ・
      ・
      ・
End With

処理:'シート2の最終行を取得
  BR = WS3.Range("A65536").End(xlUp).Row
 
 'シート1を6列目に抽出条件を1月1日〜12月31日目までと設定してオートフィルタを設定する。

With WS2
  .AutoFilterMode = 0
  .Range("A2:A" & BR).CurrentRegion.AutoFilter 6, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2006/12/31"
End With

'もし、2列目以降が空白なら、処理2に進む
If WorksheetFunction.CountA(Range("A2:A65536") _
   .SpecialCells(xlCellTypeVisible)) = 0 Then
   GoTo 処理2
   End If
'サンプルシートのB列の空白を含む最終行を取得
Set rngTemp = wb1.Cells(Rows.Count, 2).End(xlUp).Offset(1)
'シート3の可視セルの最終行までを 
With WS3.Range("A2", WS3.Range("A65536").End(xlUp)) _
            .SpecialCells(xlCellTypeVisible)
'シート3の可視セルを列ごとサンプルシートへ転記
   WS3.AutoFilter.Range.SpecialCells (xlCellTypeVisible)
  .Offset(, 3).Copy
   rngTemp.Offset(, -3).PasteSpecial Paste:=xlValues
      ・
      ・
      ・
End With 

処理2:'サンプルシートのA8を基準にソートする。 
Const myOrder As Integer = xlAscending
    wb1.Range("A8:U1252").Sort _
    Key1:=Range("A8"), _
    Order1:=myOrder, _
    Header:=xlNo, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlSortRows
End Sub
という感じです。
処理の内容(フィルタの条件や抽出元)がシート毎に違うので、Forは使えないかなと思ったのですが・・・。
使えますか?

【37377】Re:オートフィルタの結果がもし空白なら
発言  Jaka  - 06/5/2(火) 11:16 -

引用なし
パスワード
   >Set WS1 = Sheet(1)
>Set WS2 = Sheet(2)
>Set WS3 = Sheet(3)
???コンパイルエラーにならないのでしょうか?

>.Range("A2:A" & ar).CurrentRegion.AutoFilter 5, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2007/12/31"
CurrentRegionを使うなら、これ↓で良いと思います。が、
データ部がCurrentRegionで確実に取得できるデータ状態である事が前提になります。
.Range("A2").CurrentRegion.AutoFilter 5, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2007/12/31"

>'もし、2列目以降が空白なら、処理に進む
>  If WorksheetFunction.CountA(Range("A2:A65536") _
>  .SpecialCells(xlCellTypeVisible)) = 0 Then
2列目以降でなく、2行目移行です。
こういう事は正確に書かないと、すれ違いの元になります。

とりあえず1部分だけですけど...。

With WS1
  .AutoFilterMode = 0
  With .Range("A2").CurrentRegion
    .AutoFilter 5, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2007/12/31"
    'もし、2列目以降が空白なら、処理に進む
    '他にやり方が無いわけでもないですが、単純にタイトル行は
    '必ずカウントされるから(最低が1)、2より少なければで無しと判断して処理。
    'ただ、エクセル関数等も1と判断される( = "" もカウント)。
    'データを見てないので、その辺の判断はわかりません。
    If WorksheetFunction.CountA(.Columns("A") _
     .SpecialCells(xlCellTypeVisible)) < 2 Then
     GoTo 処理
    End If
  End With
End With

【37379】追加
発言  Jaka  - 06/5/2(火) 13:21 -

引用なし
パスワード
   >'可視セルの最終行までを選択
>With WS1.Range("A2", WS1.Range("A65536").End(xlUp)) _
            .SpecialCells(xlCellTypeVisible)
[#37355]のリンク先全く読んでいないみたいですけど.....。

【37380】Re:追加
お礼  momo  - 06/5/2(火) 14:27 -

引用なし
パスワード
   ハチさん、Keinさん、Jakaさん
ありがとうございます。

おかげさまで無事に解決致しました。


▼Jaka さん:
>>'可視セルの最終行までを選択
>>With WS1.Range("A2", WS1.Range("A65536").End(xlUp)) _
>            .SpecialCells(xlCellTypeVisible)
>[#37355]のリンク先全く読んでいないみたいですけど.....。

リンク先拝見したのですが、解決方法がわからず、
注意1の←の部分にフィルタをおいていたのですが、
私の解釈が間違っていたようですね。
お手間を取らせて申し訳ありませんでした。
もし、よろしければ、

[#37355]のリンク先の最終的な解決策はどこなのか教えて頂けませんでしょうか?

Sub 注意1()
  Dim AR As Long, MyRag As Range

  'AR = Range("A65536").End(xlUp).Row  '← フィルタする前の最終行を使えば大丈夫です。

  Range("A1").AutoFilter Field:=1, Criteria1:="8"

【37381】Re:追加
発言  Jaka  - 06/5/2(火) 15:30 -

引用なし
パスワード
   >#37355]の流用
要するに、抽出する時にフィルタする前の範囲とフィルタした後の範囲を、見た目で判断して変えてはダメだと言うこと。
フィルタする前と同じ範囲での表示セルを取得すればいい。
(ある特定データパターンでの不具合をなくす為。)

>私の解釈が間違っていたようですね。
一応、読んでいるかどうかとしましたが、
何度かテストして体験してみないと、どんな不具合なのかはわからないと思います。

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