execl 儲存格顏色排序
我有一推數字其中有""記號視為黃色填滿儲存格,需要整列排序在右側
因為有很多無法用格式化條件一列一列來排序需要用程式來排序...
還請各位高手幫幫忙....謝謝.....^_^
A B C D E F G H
1 10 "0" 0 10 "3" 8 1
2 "9" 0 1 9 "2" 7 0
3 8 13 "0" 8 1 "6" 2
4 個解答
- 准提部林Lv 76 年前最佳解答
Sub 重排序()
Dim xR As Range
For Each xR In ActiveSheet.UsedRange
If xR.Interior.ColorIndex <> xlNone Then
xR.Cut Cells(xR.Row, Columns.Count).End(xlToLeft)(1, 2)
End If
Next
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
End Sub
2015-03-12 16:28:01 補充：
測試檔，玩看看：
2015-03-13 21:46:19 補充：
EXCEL VBA．將〔黃底色〕儲存格向右方排列
＜．准提部林．＞
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
■程式碼：
Sub 排序及計算()
Dim xR As Range, xA As Range, Arr&(), N&
Application.ScreenUpdating = False
With ActiveSheet.UsedRange '取得使用範圍
Set xR = .Item(.Columns.Count) '取得範圍右上角（最後欄的第一格）
'↓若文字為藍色,表示為之前的統計欄，必須先清除
If xR.Font.Color = vbBlue Then Columns(xR.Column).Clear
End With
With ActiveSheet.UsedRange '重新取得使用範圍
'↓範圍右一空白欄填入文字（做擋牆，防止黃色格貼回資料範圍內）
.Columns(.Columns.Count + 1) = "A"
ReDim Arr(1 To .Rows.Count, 0) '設一個陣列(統計黃色格存放用)
For Each xR In .Cells
If xR.Interior.Color = vbYellow Then
xR.Cut Cells(xR.Row, Columns.Count).End(xlToLeft)(1, 2) '剪下黃色格往右貼
Arr(xR.Row, 0) = Arr(xR.Row, 0) + 1 '黃色格個數累計
N = N + 1
End If
Next
.Columns(.Columns.Count + 1).Clear
End With
If N = 0 Then Exit Sub
'刪除範圍中空白格（編輯．到．特殊．空格）
ActiveSheet.UsedRange.SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
Set xA = ActiveSheet.UsedRange '重新取得使用範圍
With xA.Columns(xA.Columns.Count + 1) '範圍右一空白欄
.Value = Arr '填入統計數
.Font.Color = vbBlue '設文字為藍色(與資料做區隔)
.Font.Bold = True '設文字為粗體
End With
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－
＜範例檔＞下載：
檔案名稱：20150312a01(儲存格變色及排序)
下載連結：http://www.funp.net/946777
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
2015-03-13 21:47:35 補充：
已在範例檔中加入註解，並小修程式，
請重新下載！
- 6 年前
回Lopez...沒錯:
第一列排序後會變成:
10 0 10 8 1 "0" "3"
不知有什麼好辦法?....謝謝
2015-03-12 14:21:14 補充：
准提部林兄的方法果然不錯....不愧為大師....^_^
我還有一個問題是否可以請准提部林兄幫我解答....
就是有沒有程式幫我計算在另一個欄位顯示"黃色填滿儲存格"的總數呢?
不好意思剛剛才想到....還請准提部林兄幫我解答....^_^...謝謝。
2015-03-13 17:34:19 補充：
准提部林兄的方法果然可行...謝謝你...^_^
准提部林兄的程式寫得非常好
方便的話可否在旁邊加中文註解
也讓我也能了解程式中的意思...哈...哈
沒空也沒關係....謝謝了....^_^
