Board logo

標題: [發問] 請問如何將資料轉換成TOP 10 [打印本頁]
作者: hero007    時間: 2014-10-6 16:24     標題: 請問如何將資料轉換成TOP 10

各位大大好,小弟想將資料依系列分析出商品排名
但研究了幾天並沒有太大的頭緒
不知有沒有好心的大大能協助指教比較適合的作法
謝謝

下圖為來源資料
需求是希望將依商品類別再依商品編號的數量取得前10名或前30名的明細資料
[attach]19298[/attach]

下圖為希望呈現的結果資料
[attach]19299[/attach]
作者: GBKEE    時間: 2014-10-7 11:28

回復 1# hero007
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, Rng As Range
  4.     With Sheets("TOP10")
  5.         Sheets("工作表1").Rows(1).Copy .Range("A1")
  6.         .UsedRange.Offset(1) = ""
  7.         .Activate
  8.     End With
  9.     Application.ScreenUpdating = False
  10.     Set Rng = Sheets("工作表1").Cells(1, Sheets("工作表1").Columns.Count)
  11.     Sheets("工作表1").Range("A:A").AdvancedFilter xlFilterCopy, , Rng, True
  12.     'AdvancedFilter(進階篩選):  [商品類別]不重複的個項 到 Rng
  13.     Rng.Sort Rng, xlAscending, Header:=xlYes  'Sort : 排序
  14.     Set Sh = Sheets.Add                     '這活頁簿中新增工作表
  15.     Set Rng = Rng.Offset(1)                 '下移一列
  16.     Do While Rng <> ""
  17.         With Sheets("工作表1")
  18.             .Range("A1").AutoFilter 1, Rng  'AutoFilter(自動篩選):  [商品類別]的準則= Rng
  19.             .Range("A:E").Copy Sh.[A1]      '自動篩選後的資料複製到新增工作表
  20.         End With
  21.         With Sh
  22.             .Range("A1").AutoFilter Field:=4, Criteria1:="10", Operator:=xlTop10Items
  23.             'AutoFilter(自動篩選):  [數量] 最大數值的前10項,
  24.             '**準則 Criteria1:="15" -> 前15項 ***
  25.             .UsedRange.Offset(1).Copy Sheets("TOP10").Range("A" & Sheets("TOP10").Rows.Count).End(xlUp).Offset(1)
  26.             '最大數值的前10項複製到Sheets("TOP10")
  27.         End With
  28.         Set Rng = Rng.Offset(1)                '下移一列
  29.     Loop
  30.     Sheets("工作表1").Cells.AutoFilter
  31.     '工作表有自動篩選,在一次的自動篩選,可取消工作表上的自動篩選
  32.     Rng.EntireColumn = ""
  33.     Application.DisplayAlerts = False
  34.     Sh.Delete
  35.     Application.DisplayAlerts = True
  36.     Application.ScreenUpdating = True
  37. End Sub
複製代碼
作者: hero007    時間: 2014-10-7 15:41

先感謝超級版主的提供的方法
小弟正在測試及研究版主的寫法
晚點再回報結果
非常感恩^^
作者: hero007    時間: 2014-10-7 18:09

GBKEE 版主
請問一下 我將你的程式碼復製到一個模組後讓他執行
執行幾次迴圈時會在".Range("A:E").Copy Sh.[A1]"這行出現兩種錯誤訊息
第一種：
執行階段錯誤 '-2147417848 (80010108)':
'Copy' 方法 ('Range'物件) 失敗
第二種：
執行階段錯誤 '1004':
Class Range的Copy方法失敗

不太確定是什麼原因造成的?
這行感覺很簡單就是將新增的sheets內的前十筆資料Copy到TOP 10工作表，但有時跑第二次迴圈就出錯，有時跑4~5次才出錯，甚至連錯誤訊息都沒有Excel直接當掉重啟，不知是環境問題造成還是???
電腦環境是
CPU I7-3770S
RAM 16GB
Office 2013
作者: GBKEE    時間: 2014-10-8 07:59

回復 4# hero007

執行階段錯誤 '-2147417848 (80010108)': 參考這裡 試試看
執行階段錯誤 '1004':  參考這裡,加入存檔的程式碼 試試看
你的附檔2003版中執行2#的程式沒有錯誤發生
試試修改看看
  1. With Sheets("工作表1")
  2.             .Range("A1").AutoFilter 1, Rng  'AutoFilter(自動篩選):  [商品類別]的準則= Rng
  3.             '******* 試試看可否在你的Excel環境中解決: 執行階段錯誤 '1004': Class Range的Copy方法失敗
  4.             Sh.AutoFilterMode = False
  5.             '********
  6.             .Range("A:E").Copy Sh.[A1]      '自動篩選後的資料複製到新增工作表
  7.         End With
複製代碼
作者: hero007    時間: 2014-10-8 17:20

感謝GBKEE版主的協助呀
目前問題看似都排除囉
讓我看到不同的寫法^^

而我昨日也有嘗試加入"Sh.AutoFilterMode = False"這句語法
也加過延遲幾秒後再執行".Range("A:E").Copy Sh.[A1]"
還是偶發出錯
不過今日好像又都好了，不過保險起見還是保留將篩選取消
非常感謝呀^^



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)