Results of 1 - 1 of about 4265 for オートフィルタ (0.004 sec.)
- [[20151228094112]]
- #score: 4241
- @digest: 0cd43ea808412ba2219676a67a11f619
- @id: 69591
- @mdate: 2016-01-08T05:40:09Z
- @size: 15577
- @type: text/plain
- #keywords: normalize (51728), grpcode (44364), 約コ (39040), 障率 (30463), 故障 (16311), 率2 (8639), mrow (8570), dataoption (8545), xlsortonvalues (7903), sortfields (7568), ー解 (7178), 更箇 (6729), 集約 (6712), 名変 (6598), 部品 (6576), 除. (5993), xlsortnormal (5941), usedrange (5458), yyyymm (5371), sorton (5236), 機種 (4950), 生成 (3695), xlascending (3568), parent (3483), トフ (3088), autofiltermode (3062), オー (2638), ルタ (2489), order (2466), 分割 (2292), autofilter (2275), フィ (2085)
- 『生成されたシートにフィルターを最初から設置しておきたい。』（Lila）
いつもお世話になっております。 [[20151022153817]] 『別ブックを複数使用した部品交換率の表』（Lila） こちらでβさんに頂いた以下のコード2つに、オートフィルターを設置するためのコード（Range("A4").AutoFilter）を追加したいのですが、何処に入れて良いのかが解りません・・・。 コード1の方はSheet2を生成しているこの箇所かなぁ・・・?とは思っているのですが・・・ 【 Set shA = Workbooks("部品データベース.xlsm").Sheets("Sheet2") '商品別部品使用数（集約表）（★ブック名、シート名変更箇所） Set shC = Workbooks("30-21 MTBF 機種別小分類.xlsx").Sheets("30-21 MTBF 機種別小分類") '稼働台数（★ブック名、シート名変更箇所） Set dicA = CreateObject("Scripting.Dictionary") Set dicC = CreateObject("Scripting.Dictionary") For Each c In shC.Range("A2", shC.Range("A" & Rows.Count).End(xlUp)) k = Format(c.Value, "yyyymm") & normalize(c.Offset(, 1).Value) '年月+集約コード dicC(k) = dicC(k) + c.Offset(, 2).Value '稼働台数 Next】 お手数ですが、ご教示ください。 よろしくお願い致します。 【コード1】 Function normalize(s As String) As String normalize = WorksheetFunction.Clean(WorksheetFunction.Trim(s)) End Function Sub 故障率2() Dim shA As Worksheet Dim shB As Worksheet Dim shC As Worksheet Dim c As Range Dim dicA As Object Dim dicC As Object Dim k As Variant Dim mCol As Long Dim mRow As Long Dim j As Long Dim sv As String Dim parts As String Dim yyyymm As String Dim n As Long Dim Sp As Shape Application.ScreenUpdating = False Set shB = ThisWorkbook.Sheets("Sheet2") shB.Cells.Clear ThisWorkbook.Sheets("Sheet1").Cells.Copy shB.Range("A1") '故障部品データベース（★シート名変更箇所） For Each Sp In shB.Shapes Sp.Delete Next Set shA = Workbooks("部品データベース.xlsm").Sheets("Sheet2") '商品別部品使用数（集約表）（★ブック名、シート名変更箇所） Set shC = Workbooks("30-21 MTBF 機種別小分類.xlsx").Sheets("30-21 MTBF 機種別小分類") '稼働台数（★ブック名、シート名変更箇所） Set dicA = CreateObject("Scripting.Dictionary") Set dicC = CreateObject("Scripting.Dictionary") For Each c In shC.Range("A2", shC.Range("A" & Rows.Count).End(xlUp)) k = Format(c.Value, "yyyymm") & normalize(c.Offset(, 1).Value) '年月+集約コード dicC(k) = dicC(k) + c.Offset(, 2).Value '稼働台数 Next With shA.Range("A1", shA.UsedRange) With .Offset(2, 1).Resize(.Rows.Count - 2, .Columns.Count - 1) For Each c In .Cells k = normalize(c.EntireRow.Cells(1).Value) & vbTab & normalize(c.EntireColumn.Cells(1).Value) '部品番号+集約コード dicA(k) = dicA(k) + c.Value '集約コード内部品数 Next End With End With With shB With .UsedRange mCol = .Columns.Count mRow = .Rows.Count End With For j = mCol - 11 To 5 Step -12 '最終ブロックの先頭列からE列まで 12列単位で処理 sv = normalize(.Cells(1, j).Value) '集約コード .Columns(j).Resize(, 6).Delete .Cells(1, j).Value = sv With .Range(.Cells(5, j), .Cells(mRow, j + 5)) For Each c In .Cells parts = normalize(c.EntireRow.Cells(1).Value) yyyymm = Format(c.EntireColumn.Cells(2).Value, "yyyymm") n = dicA(parts & vbTab & sv) * dicC(yyyymm & sv) If n = 0 Then c.Value = "" Else c.Value = c.Value / n End If Next .NumberFormatLocal = "0.00%" End With Next End With MsgBox "処理が完了しました。" End Sub 【コード2】 Sub 分割2() Dim fSh As Worksheet Dim tSh As Worksheet Dim mCol As Long Dim mRow As Long Dim j As Long Dim x As Long Dim myCode As String Dim grpCode As String Dim grpList As Range Dim f As Range Dim dic As Object Dim shn As Variant Dim r As Range Dim d As Range Application.ScreenUpdating = False Set dic = CreateObject("Scripting.Dictionary") 'シート生成辞書 With Sheets("グループ").Range("A1").CurrentRegion Set grpList = .Offset(, 1).Resize(, .Columns.Count - 1) End With Set fSh = Sheets("Sheet2") '元シート With fSh.Range("A1", fSh.UsedRange) mCol = .Columns.Count mRow = .Rows.Count End With For j = 5 To mCol Step 6 '集約ブロックの先頭列を抽出 myCode = fSh.Cells(1, j).Value '集約コード Set f = grpList.Find(What:=myCode, LookAt:=xlWhole) If f Is Nothing Then MsgBox myCode & " のグループ登録がないので処理をスキップします" Else If WorksheetFunction.CountA(fSh.Cells(3, j).Resize(mRow - 2, 6)) > 0 Then '★ grpCode = f.EntireRow.Cells(1).Value 'グループコード If Not dic.exists(grpCode) Then Application.DisplayAlerts = False If IsObject(Evaluate("'" & grpCode & "'!A1")) Then Sheets(grpCode).Delete Application.DisplayAlerts = True Worksheets.Add After:=Worksheets(Worksheets.Count) Set tSh = ActiveSheet tSh.Name = grpCode fSh.Range("A1").Resize(mRow, Columns("P").Column).Copy 'セル幅コピー tSh.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False tSh.Cells.Clear fSh.Range("A1").Resize(mRow, 3).Copy tSh.Range("A1") dic(grpCode) = True Else Set tSh = Sheets(grpCode) End If With tSh.Range("A1", tSh.UsedRange) If .Columns.Count < 5 Then x = 5 Else x = .Columns.Count + 1 End If End With fSh.Cells(1, j).Resize(mRow, 6).Copy tSh.Cells(1, x) End If '★ End If Next '空白行の削除 For Each shn In dic With Sheets(shn).UsedRange Set d = Nothing For Each r In .Offset(4, 4).Resize(.Rows.Count - 4, .Columns.Count - 4).Rows If WorksheetFunction.CountA(r) = 0 Then If d Is Nothing Then Set d = r Else Set d = Union(d, r) End If End If Next If Not d Is Nothing Then d.EntireRow.Delete End With Next End Sub ＜ 使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- オートフィルターを設定するのは、どのブックのどのシートですか? （β） 2015/12/28(月) 13:32 ---- 例によって忘却の彼方なんですが、オートフィルターを設定するシートの、その設定イメージもアップいただけるとありがたいです。 関連のシート、タイトル行が複数行のケースもありますよね。 でもオートフィルターは、あくまでタイトル行が1行ですので、具体的には、どこにどのような▼を設定したいのかな? （β） 2015/12/28(月) 16:20 ---- βさん おはようございます。 どのブックかというと、故障部品のリストなので、Bブックですね。 そこで故障率の計算がされて、「Sheet2」が生成される、というコードを頂いたのですが、その生成されたシート「Sheet2」にオートフィルター（無設定）を付けたいのです。 もうひとつは、その「Sheet2」からグループ分けを行ったそれぞれのシートにも同じく無設定のオートフィルターを付けておきたいなと思っています。 すでに年末年始休暇に入ってしまい、実データのレイアウトはとれないのですが、以前UPしたものを編集してみました。 下記のレイアウトの4行目が空白なのですが、そこにオートフィルターを設定したいです。 「Sheet2」の方は、E列からの6行づつデータが、Sheet1に登録した機種分ずらっと並んでいます。 グループ分けしたものは、今の所1〜4機種ぐらいづつで分かれています。 よろしくお願いします。 【レイアウト】 |[A] |[B] |[C] |[D]|[E] |[F] |[G] |[H] |[I] |[J] | [1] |部品コード |品名 |英語品名 | | aaaaaa | [2] | | | | | | | | | | | [3] | | | | |2015/05|2015/06|2015/07|2015/08|2015/09|2015/10| [4] | | | | | | | | | | | [5] |MP-M015001|abcdeeeeessssa | | | 4.02%| 0.01%| 0.01%| 4.02%| 0.01%| 4.02%| [6] |MP-M015372|sdfhrlaaaaaa | | | 0.01%| 0.01%| 0.01%| 0.02%| 0.01%| 0.01%| [7] |MP-M603760|hsummmssann | | | 0.02%| 0.00%| 0.02%| 0.02%| 0.00%| 0.02%| [8] |MP-M905240|mmmmkkkjkiuuuuu | | | 0.02%| 0.02%| 0.02%| 0.02%| 0.02%| 0.02%| [9] |MP-1033477|lkuddsjoueeeeesa | | | 0.00%| 0.00%| 0.00%| 0.01%| 0.00%| 0.00%| [10]|MP-E000019|amsdbauiddddfvn | | | 0.01%| 0.01%| 0.01%| 0.01%| 0.01%| 0.01%| [11]|MP-E103961|dsuioeblvlsm,,,,,nn| | | 0.00%| 0.00%| 0.00%| 0.00%| 0.01%| 0.00%| （Lila） 2015/12/29(火) 08:46 ---- オートフィルター設定部分だけですが、サンプルです。 (アップ後、ちょこっと訂正） Sub Sample() With Sheets("Sheet2") .AutoFilterMode = False '念のためにオートフィルター解除 .UsedRange.Offset(3).Resize(.UsedRange.Rows.Count - 3).AutoFilter End With End Sub 追記）12/29 13:11 ↑で生真面目に（?）Resizeで領域行数も指定しましたが、よく考えれば、UsedRangeの下は空白ですので .UsedRange.Offset(3).AutoFilter でよかったです。 （β） 2015/12/29(火) 08:57 ---- βさん ありがとうございます! 業務開始したらまた検証させて頂きます^o^! （Lila） 2015/12/31(木) 17:31 ---- 新年明けましておめでとうございます。 頂いたコードを実行してみましたら、ちゃんと動作していました! ありがとうございます。 ですが、計算時に、マクロを登録したボタンを押下のみで、計算から新規生成シート（Sheet2）へのオートフィルター付与までを行いたいのですが、このコードを何処に挿入すれば良いのでしょうか? 故障率2の方で、＞MsgBox "処理が完了しました。" の前に挿入で大丈夫でしょうか? また、分割の方ではシート名を指定するのではなく、「グループ」タブのA列に入った文字列を指定していく事は可能ですか? よろしくお願い致します。 （Lila） 2016/01/06(水) 09:27 ---- あけましておめでとうございます。 ●故障率2 単一シート("Sheet2")で、かつ、そのシートは shB という変数で参照していますね。かつ、With shB とくくっています。 ですから、たとえば 最後の End With の直前に .AutoFilterMode = False '念のためにオートフィルター解除 .UsedRange.Offset(3).AutoFilter ここにいれてはいかがでしょうか。 ●分割2 各シート名は Dic に格納されています。 で、最後の処理で、各シートの空白行を削除していますが、この処理ブロックは With Sheets(shn).UsedRange ' ' ' End With と、対象領域が With でくくられていますね。 ですから、End With の直前に .Parent.AutoFilterMode = False '念のためにオートフィルター解除 .Offset(3).AutoFilter こうしてはいかがでしょうか。 故障率2 と 分割2 は With でくくっているものが、一方はシート、一方は領域ですので コードもちょっと変えています。 （β） 2016/01/06(水) 10:21 ---- βさんありがとうございます! 同じWithで処理しているので、その枠の中に入れてしまっても大丈夫なのですね。 今回も大変勉強になりました。 二つとも、ばっちり動きました! いつもいつも助けていただき、本当にありがとうございます! また何かありましたら、よろしくお願いしますm(_ _)m （Lila） 2016/01/06(水) 10:35 ---- こんにちは。 分割の方のみ、更に追加フィルターに条件を追加したいと思っています。 分割後のシートそれぞれ、J列を基準に、J、I、H、G、F、Eの順番で降順でソートしたいのです。 （5行目からデータになっています） 並び替えのVBAを調べて、以下のようなものを書いてみましたが、解らないことがあるので、ご教示ください。 .Parent.Sort.SortFields.Add _ Key:=Range("J5"), _ Order:=xlDescending 領域の指定は、βさんが先日のオートフィルターで教えてくださった「.Parent」にする事で恐らく出来たようですが、実行すると、オートフィルターの設定画面?というか、オートフィルターをクリックした状態になってしまい、自動で設定ができない（生成された全てのシートに有効になっていないような??）状態になっています。 又、一番優先されるキーはJ列ですが、その後のI列からE列の指定は同じようにこの後ろにどんどん追加していけばいいのでしょうか? よろしくお願いします＞＜。 （Lila） 2016/01/08(金) 09:37 ---- オブジェクト参照をParentで戻したり、またその UsedRange としたりして、ちょっとわかりにくくなってしまいますが 以下で試してみてください。 With Sheets(shn).UsedRange Set d = Nothing For Each r In .Offset(4, 4).Resize(.Rows.Count - 4, .Columns.Count - 4).Rows If WorksheetFunction.CountA(r) = 0 Then If d Is Nothing Then Set d = r Else Set d = Union(d, r) End If End If Next If Not d Is Nothing Then d.EntireRow.Delete '並び替え With .Parent .Sort.SortFields.Clear .Sort.SortFields.Add Key:=.Range("J5") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("I5") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("H5") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("G5") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("F5") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("E5") _ , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With .Sort .SetRange .Parent.UsedRange.Offset(3) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With .Parent.AutoFilterMode = False '念のためにオートフィルター解除 .Offset(3).AutoFilter End With （β） 2016/01/08(金) 13:50 ---- βさん、早速ありがとうございます＞＜ 昇順の箇所を降順に直して検証させていただきました所、できました! Withを使用したコードなので、前回同様、End Withの前に挿入しました。 Parentだったり UsedRangeになったりで、まだ???の部分が多いですが、少しづつ何をしているのか見ていこうと思います。 本当にありがとうございます＞＜ （Lila） 2016/01/08(金) 14:40... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201512/20151228094112.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97017 documents and 608140 words.
訪問者：