Results of 1 - 1 of about 19648 for 20�����������������������... (0.004 sec.)
- [[20080816124524]]
- #score: 2682
- @digest: 7494ee3db2237e18e8179afa68b12af2
- @id: 39567
- @mdate: 2008-08-18T00:35:21Z
- @size: 3921
- @type: text/plain
- #keywords: ナr (32330), 番19 (14647), 番20 (12059), ごf (11983), 番", (9025), 名品 (8035), 額品 (7080), 位抽 (6548), 額20 (6427), 年同 (6023), 位10 (5793), 同月 (4097), 名", (4011), んd (3757), 品番 (3623), 数20 (3521), ・前 (3501), tbl (2675), バナ (2652), ナナ (2539), 品名 (2400), 用") (2384), 上位 (2249), 較対 (2227), 業用 (2024), 照出 (2002), ubound (1722), 金額 (1711), 前年 (1501), 月・ (1471), xldescending (1422), 前月 (1381)
- 『上位抽出』（ひろ）
下記表から上位10項目を別シートに抽出し、更に前月・前年同月との比較を行いたいのですが 何を使えばいいか分からず、皆様の知恵を借りさせて下さい。 品名 品番 19.8個数 19.8金額 20.7個数 20.7金額 20.8個数 20.8金額 りんご F 20 100 25 125 21 105 みかん D 10 100 15 150 13 130 バナナ R 5 20 10 40 4 16 ・ ・ ・ 上記のような表から、 品名 品番 19.8金額 品名 品番 20.7金額 品名 品番 20.8金額 みかん D 100 みかん D 150 みかん D 130 りんご F 100 りんご F 125 りんご F 105 バナナ R 20 バナナ R 40 バナナ R 16 ・ ・ ・ といったように、それぞれの月に対して品名・品番・金額を上位10項目で返して、更に 品名 品番 20.8金額 20.7金額 19.8金額 みかん D 130 150 100 りんご F 105 125 100 バナナ R 16 40 20 ・ ・ ・ 上記のように20.8を基準として、同じ品名が前月・前年同月いくらだったかを表示させたいのです。 アドバイスお願い致します。 （追記） 元データとなる表が期ごとに分かれているため、統合させずに式で参照出来れば幸いです。 19年8月は別シートにあり、20年度と比較すると品名の増減があります。 比較対象の無いものは0で返していただければと思います。 ---- レスが付かないようなんで、スレ上げ兼冷やかしマクロです。 新しいブックで試してみませう。 Alt+F11→挿入→標準モジュールに下のコードをコピペ。 戻ってSheet1のA1からそれなりのデータを書き込みます。 Alt+F8でhiroを実行してみてくらはい。 Sheet2,Sheet3を開くと、どないでっか? （弥太郎） '-------------- Sub hiro() Dim dic As Object, i As Long, u As Integer, f As Integer Dim tbl, x(1 To 10, 1 To 5), y(1 To 10, 1 To 9) Set dic = CreateObject("scripting.dictionary") Application.ScreenUpdating = False With Sheets("sheet1") tbl = .Range("a1").Resize(.Range("a" & Rows.Count).End(xlUp).Row, 8) End With Sheets.Add ActiveSheet.Name = "作業用" With Sheets("作業用") .Range("a1").Resize(UBound(tbl, 1), UBound(tbl, 2)) = tbl For u = 1 To 3 .Range("a1").Resize(UBound(tbl, 1), UBound(tbl, 2)).Sort _ key1:=.Cells(1, 2 + u * 2), Order1:=xlDescending tbl = .Range("a1").Resize(UBound(tbl, 1), UBound(tbl, 2)) f = IIf(u = 1, 1, IIf(u = 2, 4, 7)) For i = 2 To 11 y(i - 1, f) = tbl(i, 1) y(i - 1, f + 1) = tbl(i, 2) y(i - 1, f + 2) = tbl(i, 2 + u * 2) If u = 3 Then x(i - 1, 1) = tbl(i, 1) x(i - 1, 2) = tbl(i, 2) x(i - 1, 3) = tbl(i, 8) dic(tbl(i, 1)) = i - 1 End If Next i Next u With Sheets("sheet2") .Cells.ClearContents .Cells(1, 1).Resize(, 9) = Array("品名", "品番", tbl(1, 4), "品名", "品番", _ tbl(1, 6), "品名", "品番", tbl(1, 8)) .Cells(2, 1).Resize(UBound(y, 1), UBound(y, 2)) = y End With For u = 2 To 3 For i = 2 To UBound(tbl, 1) If dic.exists(tbl(i, 1)) Then x(dic(tbl(i, 1)), u + 2) = tbl(i, 10 - u * 2) End If Next i Next u End With With Sheets("sheet3") .Cells.ClearContents .Range("a1").Resize(, 5) = Array("品名", "品番", tbl(1, 8), tbl(1, 6), tbl(1, 4)) .Range("a2").Resize(UBound(x, 1), UBound(x, 2)) = x End With Application.DisplayAlerts = False Sheets("作業用").Delete Application.ScreenUpdating = True End Sub... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/200808/20080816124524.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97025 documents and 608162 words.
訪問者：