- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
3#
發表於 2010-6-8 20:38
| 只看該作者
本帖最後由 GBKEE 於 2010-6-8 20:43 編輯
回復 1# sujane0701
試試看 只可區分儲存格色彩 有或無- Sub Ex()
- Dim i%, Rng As Range, R, D(1 To 2) As Object, C%
- For i = 7 To 6 + (3 * 8) Step 3
- If Cells(Rows.Count, i).End(xlUp) <> Cells(1, i) Then
- Set D(1) = CreateObject("Scripting.Dictionary")
- Set D(2) = CreateObject("Scripting.Dictionary")
- Set Rng = Range(Cells(1, i), Cells(1, i).End(xlDown)).Resize(, 3)
- For Each R In Rng.Columns(1).Cells
- If R.Interior.ColorIndex <> xlNone Then ' <>xlNone-> 不等於無色彩
- D(1)(R.Value) = R.Resize(, 3)
- C = R.Interior.ColorIndex '取得色彩的 No
- Else ' 無色彩
- D(2)(R.Value) = R.Resize(, 3)
- End If
- Next
- If D(1).Count > 0 Then
- With Rng(1).Resize(D(1).Count, 3)
- .Value = Application.Transpose(Application.Transpose(D(1).ITEMS))
- .Interior.ColorIndex = C
- .Sort Key1:=Rng(1), Header:=xlNo 'xlNo無標題
- End With
- End If
- If D(2).Count > 0 Then
- With Rng(D(1).Count + 1, 1).Resize(D(2).Count, 3)
- .Value = Application.Transpose(Application.Transpose(D(2).ITEMS))
- .Interior.ColorIndex = xlNone
- .Sort Key1:=Rng(D(1).Count + 1, 1), Header:=xlNo
- End With
- End If
- End If
- Next
- End Sub
|
|
發表於 2010-6-7 20:46
| 
