Board logo

標題: [發問] 關於以"儲存格底色"進行排序的問題 [打印本頁]
作者: sujane0701    時間: 2010-6-7 20:46     標題: 關於以"儲存格底色"進行排序的問題

[attach]1171[/attach]EXCEL似乎沒有提供可以讓儲存格依顏色排序的功能,小弟知道可以採用定義函數外加輔助欄的方式解決,但是小弟的工作表若要增加一欄,將會動到許多已設定好的其他表單,因此冀望或許有VBA高手大大能幫助解決.
需求已寫在附件檔案件,請路過的大大幫忙!!
作者: sujane0701    時間: 2010-6-8 20:36

天兵
老夏 發表於 2010-6-7 22:25



    謝謝老夏前輩指教~
小弟細細檢討提問內容,忽然發現是自已太過執著,想要在同一份表單上想解決問題,又迷信只有高手才能解決,其實只要增加一個空白表單,用簡單的巨集將原始資料copy過來,即可輕易的在不動原始資料的前提下處理,雖然感覺受到羞辱,不過確實有收獲,所以仍然必須表示感謝!
粗淺的問題確實可能令人厭煩,下次提問前小弟會仔細再三思考能否用其他方式解決,或許換一個思路,就能有所收獲~
作者: GBKEE    時間: 2010-6-8 20:38

本帖最後由 GBKEE 於 2010-6-8 20:43 編輯

回復 1# sujane0701
試試看 只可區分儲存格色彩 有或無
  1. Sub Ex()
  2.     Dim i%, Rng As Range, R, D(1 To 2) As Object, C%
  3.     For i = 7 To 6 + (3 * 8) Step 3
  4.         If Cells(Rows.Count, i).End(xlUp) <> Cells(1, i) Then
  5.             Set D(1) = CreateObject("Scripting.Dictionary")
  6.             Set D(2) = CreateObject("Scripting.Dictionary")
  7.             Set Rng = Range(Cells(1, i), Cells(1, i).End(xlDown)).Resize(, 3)
  8.             For Each R In Rng.Columns(1).Cells
  9.                 If R.Interior.ColorIndex <> xlNone Then  ' <>xlNone-> 不等於無色彩
  10.                     D(1)(R.Value) = R.Resize(, 3)
  11.                     C = R.Interior.ColorIndex             '取得色彩的 No
  12.                 Else  '  無色彩
  13.                     D(2)(R.Value) = R.Resize(, 3)
  14.                 End If
  15.             Next
  16.             If D(1).Count > 0 Then
  17.                 With Rng(1).Resize(D(1).Count, 3)
  18.                     .Value = Application.Transpose(Application.Transpose(D(1).ITEMS))
  19.                     .Interior.ColorIndex = C
  20.                     .Sort Key1:=Rng(1), Header:=xlNo    'xlNo無標題
  21.                 End With
  22.             End If
  23.             If D(2).Count > 0 Then
  24.                 With Rng(D(1).Count + 1, 1).Resize(D(2).Count, 3)
  25.                     .Value = Application.Transpose(Application.Transpose(D(2).ITEMS))
  26.                     .Interior.ColorIndex = xlNone
  27.                     .Sort Key1:=Rng(D(1).Count + 1, 1), Header:=xlNo
  28.                 End With
  29.             End If
  30.         End If
  31.     Next
  32. End Sub
複製代碼
作者: sujane0701    時間: 2010-6-9 20:48

謝謝各位版主們鼓勵指教~!
十分感謝GBKK版主提供的技術指導,小弟程度不佳,小弟需要仔細研究揣摩一番,期望可以學習到更高深的知識.

小弟用土方法解決顏色排序的問題,因為不懂VBA,以巨集錄製的方式取得的程式碼顯擁腫龐大,小弟無力讓"它"瘦身",希望版主大大們看了不會眼花!
土方法1:在"條碼排序"表單內先設定好GET.CELL定義,取得儲存格底色的值
土方法2:要排序的欄位,與上述取得的值之欄位,一併拷貝到新增加的表單內進行排序,以顏色的值為主排序,即可取得[依儲存格底色排序]好的資料,再將此資料拷回原始資料表單,達到不更動原始表單的原則下完成排序作業.
[attach]1189[/attach]
作者: sujane0701    時間: 2010-6-9 20:53

回復 6# sujane0701


    不確定是否因為檔案太大無法上傳,再試一次![attach]1190[/attach]



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