[[20060815232153]]　『数値が０ではないものを抽出したい』（VBA初心者なおパパ）　ページの最後に飛ぶ

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

　

『数値が０ではないものを抽出したい』（VBA初心者なおパパ）

他のシートで入力したデータを別のシートにひっぱってきました。

1　りんご　　0個　　　　0円

2　みかん　　1個　　　50円

3　すいか　　1個　　1000円

4　ぶどう　　0個　　　　0円

5　もも　　　0個　　　　0円

のようなものです。
このうち0円のものは除いて抽出（つまりみかんとすいかの値のみ抽出）して、別シートに転記したいのですが、AdvancedFilterメソッドで何度やっても、『実行時エラー’1004’抽出した範囲にはフィールド名がないか、または無効なフィールド名です。』と出てしまいます。ちなみにオートフィルター機能やフィルタオプションでも同じくダメでした。これは、抽出したい範囲の中のセルに式が入っているからなのでしょうか？ちなみに1の0個のセルには『＝Sheet1!A1』などの式が入っています。できればオートフィルター機能ではなくVBAで制御したく思います。どうぞよろしくお願いします。
（Excel2003　WindowsXP） 

 >AdvancedFilterメソッドで何度やっても、『実行時エラー’1004’抽出した範囲には
 >フィールド名がないか、または無効なフィールド名です。』と出てしまいます。
 >ちなみにオートフィルター機能やフィルタオプションでも同じくダメでした。


 これは、見出し行(項目行）がないからだと思います。
1　 品名　　個数　　　値段　　←これがないから　
2　りんご　　0個　　　　0円 
3　みかん　　1個　　　50円 
4　すいか　　1個　　1000円 　
5　ぶどう　　0個　　　　0円
6　もも　　　0個　　　　0円 


 >オートフィルター機能ではなくVBAで制御したく思います
マクロの記録で、オートフィルターを使い、コピペすれば、
基本的なコードは、出来ると思いますが・・・・
　　　　　　　　　(SHIOJII)

SHIOJIIさん、早速の回答ありがとうございます。

見出しですが、例には付け忘れましたが、

実際には付けてありそれを含めて名前をつけてあります。

あと、教えていただいたとおりにオートフィルターで

抽出、転記とやってみましたが、とても時間がかかります。

ちなみに以下のようなコードです。

sub 

 Dim myTbl as Range, copySaki as Range


 Set myTbl = Worksheets("くだもの").Range("くだものデータ")
 Set copySaki =Worksheets("集計").Range("B3")


 With myTbl
      .AutoFilter 3,　">0" 　'値段は3フィールド
      .Copy copySaki
      .AutoFilter
 End With

End sub

何かコードに問題があるのでしょうか？それとも時間のかかる処理なのでしょうか？
どうぞよろしくお願いします。 

 フィルター機能を使わないで転記する方法。
 　　　　　（弥太郎）
 '---------------------
 Sub 抽出転記()
    Dim data(), tbl
    Dim i As Long, j As Long


    With Sheets("sheet1")
        tbl = .Range("a2:c" & .Range("a65536").End(xlUp).Row).Value
        For i = 1 To UBound(tbl, 1)
            If Val(StrConv(tbl(i, 3), vbNarrow)) <> 0 Then
                j = j + 1
                ReDim Preserve data(1 To UBound(tbl, 1), 1 To 3)
                data(j, 1) = tbl(i, 1)
                data(j, 2) = tbl(i, 2)
                data(j, 3) = tbl(i, 3)
            End If
        Next i
    End With
    Sheets("sheet2").Range("a2").Resize(j, 3) = data


 End Sub


 おはようございます。
基本的にオートフィルターは、時間がかかる処理だそうです。（行数にもよりますが・・）
一方アドバンスフィルターはかなり高速だそうです。
さらに、弥太郎さんのように配列で処理すれば、もっと早くなると思います。
　まだまだ、毛の生えた初心者の私には、配列は充分使いこなせていません。
　　　　　　　　　　　　(SHIOJII)　

 あらかじめ、シート全体を別のシートに複製を作り
そのシートで、0円の行のみ行削除するマクロを作れば
比較的簡単に出来ると思いますが、どうでしょうか。（夕焼）
 複製はあらかじめ行い、その後の下記マクロで、0円行が
無くなる。


 Sub TEST()


 lastrow = Cells(Rows.Count, 3).End(xlUp).Row
 For i = lastrow To 1 Step -1
 If Cells(i, 3) = "0円" Then
 Rows(i).Delete
 End If
 Next


 End Sub


 >とても時間がかかります。 
 どのくらいの程度なのでしょうか。支障があるほどでしょうか。
  数分？、数十秒、数秒
  10秒程度なら待てる範囲ではないでしょうか？。

 > オートフィルターで抽出、転記とやってみましたが、とても時間がかかります。
 とのことでしたので、（VBA初心者なおパパ）さんのコードでシート名と範囲を変更して、
 元データを5000行ほどコピーしたのを使って試してみました。
 0.2〜0.3秒で抽出できました。結構早いと思ったのですが・・・
Sub te()
 Dim myTbl As Range, copySaki As Range
 Dim lrow As Long
lrow = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
 Set myTbl = Worksheets("Sheet1").Range("A1:C" & lrow)
 Set copySaki = Worksheets("Sheet2").Range("B3")


 With myTbl
      .AutoFilter 3, ">0"    '値段は3フィールド
      .Copy copySaki
      .AutoFilter
 End With
End Sub
 なお、（弥太郎）さんののは0.2秒弱で更に早いようでした。
 （夕焼）さんのは43.9秒と時間が必要のようでした。


 [追加]以下のAdvancedFilterで試したら0.1秒足らずでした。
 (PCの性能にもよると思いますので、余り数字は参考にならないとは思いますが・・・)
Sub te2()
Dim myTbl As Range, copySaki As Range
Dim lrow As Long
Sheets("Sheet1").Range("E1").Value = "値段"
Sheets("Sheet1").Range("E2").Value = ">0"
Sheets("Sheet2").Range("A:C").ClearContents
lrow = Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row
 Set myTbl = Worksheets("Sheet1").Range("A1:C" & lrow)
 'Set copySaki = Worksheets("Sheet2").Range("B3")
    myTbl.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet1").Range("E1:E2"), _
        CopyToRange:=Sheets("Sheet2").Range("A1"), _
        Unique:=False
End Sub
 　　
 以上です。　(Hatch)


 おっ！！　
どれが速いかですか?
私も過去重複なしの乱数の発生でやった事があります。
AutoFilterは、けっこう健闘しているではないですか。
AdvancedFilterは、速いとは知っていましたが、配列よりとは？？
[夕焼け]さんのは行削除ですから、一番時間がかかるのは当たり前ですが
数式で判定するともっと速くなるかも？
　（SHIOJII）

 >どれが速いかですか?
 いいえ・・・オートフィルタでうまくできない&遅いとのことでしたので、
 そんなことはなさそうですよ。というのと、
 AdvancedFilterでうまくできないとのことでしたので、そのサンプルにならないかと
 思って書いてみました。スピードは目安としてです。　　(Hatch)

今仕事から帰ってきたばかりです。（お盆なのに・・・）
たくさんの（！）回答をいただきありがとうございます。
本当に初心者なので、悲しいかな皆さんの回答を見ただけでは直ぐに理解できません。
特に弥太郎さんの配列？はお手上げです（涙）。
とりあえず高速なHatchさんのコードを勉強させていただきます。（lrowのあたりがよくわかりませんが勉強してみます）
ちなみに前述したコードで6行×3列ほどのデータに抽出・転記したところ55秒もかかり、絶対におかしいと思っていました。一応P4 3GHz Mem 512×2なのでPCのスペック的には問題ないと思います。また報告させていただきます。
みなさんどうもありがとうございました！ 
 >高速なHatchさんのコードを勉強させていただきます。
 グッドアイディアやと思いまっせぇ（笑
 配列をどう逆立ちさせても一般機能を取り込んだマクロには到底太刀打ちでけまへん。
 （処理速度の面からも）
 Hatchさんは5000のデータで試してますけど、50000のデータやと更に速度の違いが顕著
 に出ます。
 ヒマがあればオートフィルター、AdvanceFilter、私のコード、夕焼けさんのコードを
 それぞれ試してみてくらはい。
 　　　　　　　（弥太郎）


 ＞前述したコードで6行×3列ほどのデータに抽出・転記したところ55秒もかかり、絶対におかしいと思っていました。
 ＞一応P4 3GHz Mem 512×2なのでPCのスペック的には問題ないと思います。


 このスペックで6行×3列のデータを抽出するのに55秒・・・
 もしかしたら、＞0個のセルには『＝Sheet1!A1』などの
 この部分が原因ってこと・・・？
 Sheet1のA1のデータが配列数式などの重たい数式の結果を引っ張ってきているってことはないのかな・・・。


 ちなみに私も午前に試したときは、質問者の方のコードで数千行で(￣０￣;アッ！っと言う間でした。


 （川野鮎太郎）
お答えいただいたみなさま、どうもすみません！
まずお詫びします。

抽出の速度が極端に遅かったのはもっと別のことが原因でした！

信じられないかもしれませんが『フォントの入れすぎ』でした。

大量の不要なフォントを削除したところ超高速になりました。

みなさんからいただいた高速化の知恵は今後必ず活かしたいと思います。

しかしながら今度は別の障害にぶつかりました。

もしよければまた知恵をお貸しください。

Hatchさんのコードで難なくできたのですが、転記されたデータがおかしいのです。

個数と値段は他のシートからひっぱってきたものなのですが、

（セルの式『＝Sheet1!A1』などが入っています）

転記されるとセルの中身が違っているのです。

元元データ 　　元データ　　　　　　抽出転記データ　　　

Sheet1!A1　　　Sheet2!C1　　　　　　　　Sheet3!E1　 

           ⇒   式「=Sheet1!A1」　⇒   式「=Sheet1!A7」

セル上「1」　　　セル上「1」　　　　　　セル上「1ではない数値」

わかりにくくてすみません。

どうしてセルの中の式の番地が変化してしまうのですか？

またこのような場合の対処方法を教えてください。

（セル上の数値のみを対象に抽出できるのかと思っていました）

どうぞよろしくお願いします。（VBA初心者なおパパ） 

 こちらではAdvancedFilterで抽出したデータは値だけになっています。
 (数式はコピーされませんし、元の数式も変化しないはず）
 夕焼さんの行削除のマクロなら数式が残っているとは思いますが??　　(Hatch)

Hatchさん、ありがとうございます。

AdvancedFilterで抽出したところ数値のみ抽出・転記されました！

但し、オートフィルターではやはり数式が変化してしまいます。（？）

何故だか分かりませんが、とにかくAdvancedFilterで上手くいきましたので

そちらを利用します。

＞AdvancedFilterメソッドで何度やっても、『実行時エラー’1004’抽出した範囲にはフィールド名がないか、または無効なフィールド名です。』と出てしまいます。ちなみにオートフィルター機能やフィルタオプションでも同じくダメでした。

一番最初にこのように書きましたが、範囲を指定して名前をつけて

「Range("一覧")」

などとしていたのですが、どうやら削除もせずに

何度も名前を変更していたのが原因のようです。

本当に初心者丸出しの初歩的なミスでいろいろとご迷惑をおかけして

すみませんでした。また壁にぶつかりましたら質問させていただきます。

その際はまたよろしくお願いします。

みなさん本当にありがとうございました！

コメント返信：

[ 一覧(最新更新順) ]

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