エクセルの学校：全文検索：Hyper Estraier：オートフィルタ

Results of 1 - 1 of about 4266 for オートフィルタ (0.004 sec.)

[[20080909105521]]: #score: 4241; @digest: 13ea95d2a3bf20569fdda4fd775bbedd; @id: 39911; @mdate: 2008-09-16T10:32:42Z; @size: 21450; @type: text/plain; #keywords: sheetcheck (47158), 出ws (36556), lastrow3 (27394), lastrow1 (26395), 業者 (13679), 者名 (12139), 商店 (11704), lastrow2 (9932), 注文 (8008), クポ (6915), 力シ (6764), autofilter (6444), ws1 (6184), ブレ (6063), の注 (6012), criteria1 (4809), 業用 (4723), 用シ (4210), 文書 (3954), field (3448), ubound (3443), ト") (3327), トフ (3281), sheets (3267), ポイ (3197), ws2 (3069), tbl (2973), オー (2803), ルタ (2765), screenupdating (2696), rng (2677), レー (2586); 『誤動作の原因が判りません』（nori）
またまたお世話になります。皆様に教えていただき、動いていたのですが、変な動きをするようになってしまいました。どなたか教えていただけると有難いのですが・・・症状は、例えば、A商店にボンドを注文、B商店にビス、C株式会社にケント紙を注文するために入力シートに入力、入力シートに配置してあるコマンドボタン1をクリックするとA商店の注文書には、ボンドが書き込まれ、B商店の注文書には、ビスが書き込まれ、C株式会社への注文書には、ケント紙が書き込まれる。 A商店への注文書への書き込みは間違いなく行われるのですが、B商店、C株式会社への注文書には、それぞれの注文先への注文品とA商店への注文品が書き込まれてしまいます。何処が悪いのか目を皿のようにしてコードを見たのですが、判りません。 Private Sub CommandButton1_Click() Dim LastRow1 As Long '元データの最終行 Dim LastRow2 As Long '作業用シート「Temp」のデータの最終行 Dim LastRow3 As Long Dim SheetCheck As Integer Dim Rng As Range Dim Sh As Worksheet Dim WS1 As Worksheet Dim WS2 As Worksheet Set WS1 = Sheets("入力シート") 'データの最終行を取得 LastRow1 = WS1.Range("B65536").End(xlUp).Row '←ここで最初にデータ行を取得する If LastRow1 < 8 Then Exit Sub '←ここでデータの存在を確認する Application.ScreenUpdating = False '画面の更新を停止 '作業用シートの挿入 'Worksheets.Add(after:=WS1).Name = "Temp" Set WS2 = Sheets("Temp") '重複する業者名を除いて作業用シート「Temp」に抽出 '←フィルターはB7を含める WS1.Range("B7:B" & LastRow1).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=WS2.Range("A1"), _ Unique:=True '作業用シート「Temp」のデータの最終行を取得 LastRow2 = WS2.Range("A65536").End(xlUp).Row '抽出した各業者毎に処理を繰り返す For Each Rng In WS2.Range("A2:A" & LastRow2) '←TmpのA2から開始する '業者名のシートの有無をチェック SheetCheck = 0 For Each Sh In Worksheets If Sh.Name = Rng.Value Then SheetCheck = 1 Exit For End If Next Sh If SheetCheck = 1 Then '業者名のシートがあった場合 '業者名シートの入力されているデータの最後を求める LastRow3 = Sheets(Rng.Value).Range("B65536").End(xlUp).Row '業者名毎にデータを抽出 WS1.Range("B8").AutoFilter Field:=2, Criteria1:=Rng.Value '抽出したデータに対応する業者名のシートにデータをコピー WS1.Range("D8:K" & LastRow1).Copy Sheets(Rng.Value).Range("B" & LastRow3 + 1).PasteSpecial Paste:=xlPasteValues Else '業者名のシートがなかった場合 '業者名のシートを挿入 Worksheets.Add(after:=Sheets(Sheets.Count)).Name = Rng.Value '業者名毎のデータの抽出 WS1.Range("B8").AutoFilter Field:=2, Criteria1:=Rng.Value '抽出したデータに対応する業者名のシートにデータをコピー WS1.Range("D8:K" & LastRow1).Copy Sheets(Rng.Value).Range("B8").PasteSpecial Paste:=xlPasteValues End If WS1.Range("B8").AutoFilter 'オートフィルタの解除 Next Rng Application.DisplayAlerts = False '警告メッセージの表示を無効 WS2.Range("A:A").Clear 'Delete '作業用シートの削除 Application.DisplayAlerts = True '警告メッセージの表示を有効 WS1.Activate Application.ScreenUpdating = True '画面の更新を有効 End Sub ---- ゴメンなさい! 正常に動作する場合もあります。上記で記入したような結果の場合もある事を書き込む事を忘れてしまいました。上記で記入したような結果になる場合は、2文字の注文先名称を入力シートの先頭に書き込んだ時に発生するような気がします。ひとたび、この現象が発生すると、2文字の発注先名称が先頭にしないようにしてもダメ。再起動するとうまく行くようなのです。オートフィルを使う時には何らかの配慮が必要なのでしょうか??? (nori) ---- 基になっているスレッドはこれかな・・・必要な方のために・・・(Hatch) [[20080624202837]] [[20080612101317]] ---- 気になるのは「重複する業者名を除いて作業用シート「Temp」に抽出」で書き込まれたデータがあるとき不都合が起きる可能性がありませんか? WS2.Range("A:A").ClearContents のように、一旦クリアしてから抽出されたらいかがでしょう? (Hatch) ---- >WS1.Range("B8").AutoFilter 'オートフィルタの解除 >オートフィルを使う時には何らかの配慮が必要なのでしょうか??? 本件の原因なのか分かりませんが、 オートフィルタの解除の為に「.AutoFilter」メソッドを使うのはリスキーです。 WS1.AutoFilterMode = False とした方がよい気がします。 AutoFilterの問題点については、少し以前、余所で議論がありました。為になりますよ。 http://moug.net/faq/viewtopic.php?t=18343 http://officetanaka.net/excel/excel2007/070.htm （半平太） ---- Hatchさん、半平太さん、有難うございます。お二人が教えてくださったこと、実行してみましたが、一向に症状は治りません。 オートフィルターについての議論を読ませていただきましたが、私の知識、技量では、良く理解できませんでした。本当に難しいですね。本当に困りました。泳げもしないのに沖に出すぎた〜状態です。 ---- 失礼しました、よく見たら後ろの方でWS2.Range("A:A").Clearとクリアされてましたね。的外れなことを書いたようです(-_-;) (Hatch) ---- 参考サイトの意見を取り入れて、やってみる価値がありそうなことが、2案考えられます。 (ただし、当方は現実のデータがどうなっているのか分からないので、本当にそんなことしていいのかも分かっていません） No.1 オートフィルタを掛ける前に、WS1.Range("B8")を選択すること '業者名毎にデータを抽出 WS1.Activate '←挿入 WS1.Range("B8").Select '←挿入 WS1.Range("B8").AutoFilter Field:=2, Criteria1:=Rng.Value : Else '業者名のシートがなかった場合 : '業者名毎のデータの抽出 WS1.Range("B8").Select '←挿入 WS1.Range("B8").AutoFilter Field:=2, Criteria1:=Rng.Value No.2 オートフィルタを掛ける範囲を全て指定すること '業者名毎にデータを抽出 WS1.Range("B8").CurrentRegion.AutoFilter Field:=2, Criteria1:=Rng.Value '←CurrentRegionを挿入 : Else '業者名のシートがなかった場合 : '業者名毎のデータの抽出 WS1.Range("B8").CurrentRegion.AutoFilter Field:=2, Criteria1:=Rng.Value '←CurrentRegionを挿入（半平太） ---- まずはコード内の＞Application.ScreenUpdating = False '画面の更新を停止これをコメントアウトして画面が更新される様にし一行ずつコードを実行し各コードが本当に希望する動きをしているか確認してみるのがよいと思いますが・・・。 (HANA) ---- 半平太さん、HANAさん、ありがとうございます。ご提案戴きました、1案、2案実行してみました。結果は変わりませんでした。不思議でならないのは、ある業者名（二文字）を先頭に持ってきたときだけに起きる、と言う事です。2行目以下に入力した場合には問題なく動作しているようなのです。（これも全部確認が取った訳でないので、これからいろいろ事例で試して行きます。） HANAさん、ご提案いただきましたこと試しました。上記のように、ある事例の場合だけの現象のようで、何故かは判っておりません。今後ともよろしくお願いいたします。 ---- 何としてでもマスターせん事にはボーナス大幅アップが見込めまへんわなぁ。^^ で、参考程度にフィルターを使わない方法を作ってみました。但し、シートのレイアウトが分かりまへんから結果は欲しいもんとちがっとりまっせぇ多分。速度はフィルターと「いずれがアヤメかカキツバタ」ですワ。（弥太郎） '--------------------- Sub Non_Filter() Dim dic As Object, i As Long, n As Integer, j As Long, x, y() Dim sht, z, ky, tbl Set dic = CreateObject("scripting.dictionary") Application.ScreenUpdating = False With Sheets("入力シート") tbl = .Range("b8").Resize(.Range("b" & Rows.Count).End(xlUp).Row - 7, 10) ReDim x(1 To UBound(tbl, 1), 1 To UBound(tbl, 1), 1 To UBound(tbl, 2)) For i = 1 To UBound(tbl, 1) If Not dic.exists(tbl(i, 1)) Then j = j + 1 For n = 1 To UBound(tbl, 2) x(j, 1, n) = tbl(i, n) Next n dic(tbl(i, 1)) = Array(j, 1) Else For n = 1 To UBound(tbl, 2) x(dic(tbl(i, 1))(0), dic(tbl(i, 1))(1) + 1, n) = tbl(i, n) Next n dic(tbl(i, 1)) = Array(dic(tbl(i, 1))(0), dic(tbl(i, 1))(1) + 1) End If Next i End With Sheets("sheet3").Range("b8").Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl For i = 1 To Worksheets.Count ReDim Preserve y(i - 1) y(i - 1) = Worksheets(i).Name Next i sht = Array(y) For Each ky In dic.keys ReDim z(1 To dic(ky)(1), 1 To UBound(tbl, 2) - 2) If IsError(Application.Match(ky, sht, 0)) Then Worksheets.Add(after:=Sheets(Sheets.Count)).Name = ky For i = 1 To dic(ky)(1) For n = 1 To UBound(tbl, 2) - 2 z(i, n) = x(dic(ky)(0), i, n + 2) Next n Next i Sheets(ky).Range("b8").Resize(UBound(z, 1), UBound(z, 2)) = z Else With Sheets(ky) For i = 1 To dic(ky)(1) For n = 1 To UBound(tbl, 2) - 2 z(i, n) = x(dic(ky)(0), i, n + 2) Next n Next i .Range("b" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(z, 1), UBound(z, 2)) = z End With End If Next ky Sheets("入力シート").Select Application.ScreenUpdating = True '画面の更新を有効 End Sub ---- ＞HANAさん、ご提案いただきましたこと試しました。どの部分を試されたのですかね? 慢性的に不具合が出るデータが分かっているのなら実際に各コードがどの様な動きをしているのか目で見て確認するのが一番です。コードの各行が、どのシートに対して行われる物か分かりますよね。でしたら、それらのシートがその時にどの様になっているのか上手く行くデータではどうなっているか上手く行かないデータではどうなっているか見比べましょう。突き止める必要が有るのはある事例の場合だけ【どの時点で】通常と違う事が起きているのかと言う点です。どこかのコードのある一行を実行した結果が違っていると思いますが。 (HANA) ---- 半平太さん、ゴメンなさい。記入漏れがありました。 CurrentRegionを挿入すると、RangeクラスのCurrentregionプロパティを取得できませんと言うエラーが出てデバッグモードに入ってしまいます。 HANAさん、すみません。今、やっておりますが、職場のコンピュータ環境が悪いのでチョッと時間がかかります。 ---- えっ、いや noriさんが謝る必要は無いですよ。ゆっくりやって下さい。急ぐと気づくことも気づかなくなりますから。ただ、一つだけ。コメント記入の際は、その都度ご署名をお忘れなく。 (HANA) ---- >CurrentRegionを挿入すると、RangeクラスのCurrentregionプロパティを取得できません >と言うエラーが出てデバッグモードに入ってしまいます。あれ、済みません。こちらもそのコードの前に、このステートメントを書いて置く必要がありました。 m(__)m ↓ WS1.Activate '←挿入 (半平太) ---- HANAさん、半平太さん、いろいろとアドバイスありがとうございます。 Application.ScreenUpdating=trueにし、ブレークポイントを設定しては試してみました。期待とおりの結果のとき、期待したような結果とならないとき、いずれでも、これか?と思われるようなことは見つけられませんでした。 WS2をClearContentsせずにオートフィルターの状況も見てみましたが、これといったものを見つけることはできませんでした。WS1からWS2にコピーした書式が残ってはいましたが・・・結果として、期待とおりの結果が出る時と、出ない時の差は何かわかりませんでした。やってみなくては判らないと言う状況です。自宅のコンピュータが使えるようになれば、いろいろと実験できるのですが・・・弥太郎さん、ありがとうございます。折角、書き込んで頂いたのに、気が付きませんでした。本当にゴメンなさい。直ぐ試します。 ---- あ、いや、そのまま気づいてくださらん方が良かったのに・・・。（汗っちゅうのは、どうやら勘違いしとりまして、入力シートにあるデータを全てそれぞれのシートに抽出してしまいますんですワ、ハハハ。（力の無い笑い） InputBoxで抽出データを限定する方法はありますけど、必要おまへんわなぁ。（弥太郎） ---- まず確認ですが＞WS2をClearContentsせずにオートフィルターの状況も見てみましたが WS2に有るのは、オートフィルタの結果ではなくフィルタオプションで重複を除いて抽出した結果ですよね。それから、問題なのは「入力があるシートにデータが転記されない事」ではなく「入力があるシートに最初に出てきた社名のデータが混ざっている事」ですよね。上記が「Yes」であるならSW2の状況は正しくなされている様に思います。＞ブレークポイントを設定しては試してみました。どこにブレークポイントを設定しましたかね。全体が分からないので見るべき所が違う所かもしれませんが私だったら、ブレークポイントは＞ '業者名シートの入力されているデータの最後を求める＞ LastRow3 = Sheets(Rng.Value).Range("B65536").End(xlUp).Row この辺りに設定します。その後、[F8]を押しながら一行ずつ動かします。＞ WS1.Range("B8").AutoFilter Field:=2, Criteria1:=Rng.Value ここでは、WS1のオートフィルタが正しくRngのデータを抽出しているか。＞ WS1.Range("D8:K" & LastRow1).Copy その範囲がコピーされているか。（点線で囲われると思いますので。）＞ Sheets(Rng.Value).Range("B" & LastRow3 + 1).PasteSpecial Paste:=xlPasteValues Rngのシートをアクティブにして、貼り付けられたデータが、希望するデータと同じか。この3点を重点的に見ます。今回のご質問が、「最終的に貼り付けられたデータが希望するデータと違う」と言う事であれば、「貼り付けを行う」上記コード内で何か違ったデータが貼り付けられているとしか思えないのですが・・・。それとも、ここでは正しくデータが貼り付いているのに終わってみたらなぜだか違うデータも貼り付いているのでしょうか? (HANA) ---- ついでにInputBoxで抽出するマクロ。また、これはどっかのセルに抽出したいデータを羅列して一気に拾い出すっちゅう方法もありますなぁ。（弥太郎） '----------------- Sub Non_Filter2() Dim i As Long, n As Integer, j As Long, data As String, x, y() Dim flag As Boolean, tbl data = InputBox("抽出するデータは何でっか?") If data = "" Then Exit Sub Application.ScreenUpdating = False With Sheets("入力シート") tbl = .Range("b8").Resize(.Range("b" & Rows.Count).End(xlUp).Row - 7, 10) ReDim x(1 To UBound(tbl, 1), 1 To UBound(tbl, 2) - 2) For i = 1 To UBound(tbl, 1) If tbl(i, 1) = data Then j = j + 1 For n = 1 To UBound(tbl, 2) - 2 x(j, n) = tbl(i, n + 2) Next n End If Next i End With For i = 1 To Worksheets.Count If Worksheets(i).Name = data Then flag = True Exit For End If Next i If flag Then Sheets(data).Range("b" & Rows.Count).End(xlUp).Offset(1).Resize(j, UBound(x, 2)) = x Else Worksheets.Add(after:=Sheets(Sheets.Count)).Name = data Sheets(data).Range("b8").Resize(j, UBound(x, 2)) = x End If 'Sheets("入力シート").Select Application.ScreenUpdating = True '画面の更新を有効 End Sub ---- なかなか解決しないようですね・・・原因はたぶんAutoFilterのところでしょうから、（弥太郎）さんの書いたようなコードを使えば問題はなくなると思われますが、以下私の推理を書いてみます。 > 不思議でならないのは、ある業者名（二文字）を先頭に持ってきたときだけに起きる、と言 > う事です。2行目以下に入力した場合には問題なく動作しているようなのです。 7行目が列見出しで、8行目以降にデータが入力されるようですから、このことから推測すると、 オートフィルタが実行されるときExcelがデータ範囲を誤認識しているのではないかと・・・実際は7行目からがデータ範囲と認識されればよいのに、 WS1.Range("B8").AutoFilter Field:=2 と書いているためになぜかしら8行目からが認識されたりするのでは、という推理です。対策としては上の方で（半平太）さんが書いておられたように、「オートフィルタを掛ける範囲を全て指定すること」で、回避できるのではないかと思います。ただし、私なら.CurrentRegionとExcel任せにせず、 Dim myRange As Range Set myRange = WS1.Range("A7:I" & LastRow1) myRange.AutoFilter Field:=2, Criteria1:=Rng.Value と指定します。あっ、AutoFilterを使わないのが一番の解決法ですね・・・以上・・・あくまでも推理です (^^ゞついでですので、こちらでtestしているのは以下のようなコードに改変しています。こちらでは、変な現象が出ないの、解消できるかは全く不明ですが・・・ (Hatch) Private Sub CommandButton1_Click() Dim LastRow1 As Long, LastRow2 As Long, LastRow3 As Long Dim SheetCheck As Integer Dim Sh As Worksheet, WS1 As Worksheet, WS2 As Worksheet Dim Rng As Range Dim myData As Range Set WS1 = Sheets("入力シート") LastRow1 = WS1.Range("B65536").End(xlUp).Row If LastRow1 < 8 Then Exit Sub Application.ScreenUpdating = False Set myData = WS1.Range("A7:I" & LastRow1) '作業用シートの挿入 ' Worksheets.Add(after:=WS1).Name = "Temp" Set WS2 = Sheets("Temp") WS1.Range("B7:B" & LastRow1).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=WS2.Range("A1"), _ Unique:=True LastRow2 = WS2.Range("A65536").End(xlUp).Row If WS1.AutoFilterMode Then WS1.AutoFilterMode = False End If For Each Rng In WS2.Range("A2:A" & LastRow2) SheetCheck = 0 For Each Sh In Worksheets If Sh.Name = Rng.Value Then SheetCheck = 1 Exit For End If Next Sh If SheetCheck = 1 Then LastRow3 = Sheets(Rng.Value).Range("B65536").End(xlUp).Row myData.AutoFilter Field:=2, Criteria1:=Rng.Value WS1.Range("D8:K" & LastRow1).SpecialCells(xlCellTypeVisible).Copy Sheets(Rng.Value).Range("B" & LastRow3 + 1).PasteSpecial Paste:=xlPasteValues Else Worksheets.Add(after:=Sheets(Sheets.Count)).Name = Rng.Value myData.AutoFilter Field:=2, Criteria1:=Rng.Value WS1.Range("D8:K" & LastRow1).SpecialCells(xlCellTypeVisible).Copy Sheets(Rng.Value).Range("B8").PasteSpecial Paste:=xlPasteValues End If WS1.AutoFilterMode = False Next Rng Application.DisplayAlerts = False WS2.Range("A:A").Clear Application.DisplayAlerts = True WS1.Activate Application.ScreenUpdating = True End Sub ---- 以前のレスで、お付き合いいたしましたみやほりんです。 [[20080716113841]] なにか、上記のときから改善してないような。＞ A商店への注文書への書き込みは間違いなく行われるのですが、B商店、C株式会社へ＞の注文書には、それぞれの注文先への注文品とA商店への注文品が書き込まれてしまいま＞す。最初に提示されているコードでも、本来のデータに加えて、別のデータがコピーされる、という動作は、考えにくいんですよね、私には。別のイベントマクロが走っている、ということは、ありませんか? （これもステップインデバッグで確認できるはずです）不審な動作なので、新規ブックへデータやコードを引越しして作り直して見るのも思い切った検証手段。 (みやほりん)(-_∂)b ---- 8行目がA商店のデータであった場合、そして何らかのおかしなことが起こって 8行目以降でオートフィルタがかかってしまった。つまり、8行目がタイトル行と認識された。コピー範囲は8行目からだから他のシートにもこのA商店のデータが貼り付けられた。と推理したのですが、起こり得ない現象ですかね・・・・(Hatch) ---- HANAさん、お世話になります。＞まず確認ですが＞＞WS2をClearContentsせずにオートフィルターの状況も見てみましたが＞＞WS2に有るのは、オートフィルタの結果ではなく＞フィルタオプションで重複を除いて抽出した結果ですよね。 yse です。＞それから、問題なのは＞＞「入力があるシートにデータが転記されない事」＞ではなく＞＞「入力があるシートに最初に出てきた社名のデータが混ざっている事」＞ですよね。 yseです。上記が「Yes」であるならSW2の状況は正しくなされている様に思います。＞ブレークポイントを設定しては試してみました。どこにブレークポイントを設定しましたかね。上から順に片っ端かやってみました。全体が分からないので見るべき所が違う所かもしれませんが私だったら、ブレークポイントは＞ '業者名シートの入力されているデータの最後を求める＞ LastRow3 = Sheets(Rng.Value).Range("B65536").End(xlUp).Row この辺りに設定します。これについてはもう一度、ご指摘いただいた様にブレークポイントを設定してやり直して見ます。弥太郎さん、ありがとうございます。動いているように思いました。いろいろな場合を切り分けて試して見ます。みやほりんさん、ありがとうございます。最終的には、新規ブックに引っ越して作り直さなければと考えておりますが、教えていただいたコードの意味が判らないのにやっても無駄かなと思い、コードを調べながら試して終わりましたら、やって見ます。どなたか判りませんが、コードを見直し、直してくださった方、ありがとうございます。このコードでは、期待とおりの結果が出ております。コードの一つ一つ調べながら試しております。皆様、本当にありがとうございます。 ---- > どなたか判りませんが、コードを見直し、直してくださった方多分Hatchさんのコメントのことでしょうけど、よく見ないと分かりづらいですね(^_^A; （川野鮎太郎） ---- ＞これについてはもう一度、ご指摘いただいた様にブレークポイントを設定して＞やり直して見ます。その後、ステップインもやって居られますかね? ブレークポイントを設定して止める目的はステップインで確認するためです。＞上から順に片っ端かやってみました。と言う事は、ステップインでの確認をやって居られないように思いますが・・・。不具合が有るコードの何処に不具合があるのか見つける方法ですので、早い内に習得なさって於いた方が宜しいと思いますよ。 (HANA) ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/200809/20080909105521.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ