[發問] (已解決)如何同一區塊相同資料標顏色

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

2^#

發表於 2012-5-11 12:18 | 只看該作者

回復 1# freeffly

A欄必須要排序

Sub xx()
Dim d As Object
Dim Rng As Range
Columns("A").Interior.ColorIndex = 0
Set d = CreateObject("Scripting.Dictionary")
For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
d(A.Value) = A.Value
Next
Ar = d.Items
For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
For R = 0 To d.Count Step 2
If A = Ar(R) Then
If Rng Is Nothing Then
Set Rng = A
Else
Set Rng = Union(Rng, A)
End If
End If
Next R
Next
Rng.Interior.ColorIndex = 6
End Sub

複製代碼

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

3^#

發表於 2012-5-11 13:12 | 只看該作者

回復 2# register313

謝謝
字典的對我來說還很難
感覺比文言文還難

字典兩各字還真難理解

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

4^#

發表於 2012-5-21 11:57 | 只看該作者

回復 2# register313

大大
剛剛發現會有列數限制
這各有辦法克服嗎
太多好像會出現陣列超出範圍的問題

Book122.rar (9.17 KB)

字典兩各字還真難理解

register313

　頭銜: 麻辣路人甲

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

5^#

發表於 2012-5-21 13:13 | 只看該作者

回復 4# freeffly
不是列數限制
之前程式稍作修正

Sub xx()
Dim d As Object
Dim Rng As Range
Dim Ar
Columns("A").Interior.ColorIndex = 0
Set d = CreateObject("Scripting.Dictionary")
For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
d(A.Value) = A.Value
Next
Ar = d.Items
For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
For R = 1 To d.Count - 1 Step 2
If A = Ar(R) Then
If Rng Is Nothing Then
Set Rng = A
Else
Set Rng = Union(Rng, A)
End If
End If
Next R
Next
Rng.Interior.ColorIndex = 6
End Sub

複製代碼

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

6^#

發表於 2012-5-21 13:38 | 只看該作者

回復 5# register313

大大請問第12行代碼的意思

如果用原代碼後面加-1也可行

For R = 0 To d.Count - 1 Step 2

複製代碼

或是原代碼1改為0也行

For R = 1 To d.Count Step 2

複製代碼

大大新的代碼是這各還有Dim Ar

For R = 1 To d.Count - 1 Step 2

複製代碼

作了之後標顏色區塊有點不一樣可是會同樣效果
也不會出現陣列超出範圍
為什麼會有差異?

字典兩各字還真難理解

register313

　頭銜: 麻辣路人甲

帖子: 967
主題: 0
精華: 0
積分: 1001
點名: 0
作業系統: WIN XP
軟體版本: OFFICE 2003
閱讀權限: 50
性別: 男
來自: 台北
註冊時間: 2010-11-29
最後登錄: 2022-5-17

2012龍年全勤獎章熱烈參與勳章

7^#

發表於 2012-5-21 15:24 | 只看該作者

回復 6# freeffly

說明詳見檔案

Test.rar (13.89 KB)

帖子: 586
主題: 123
精華: 0
積分: 763
點名: 0
作業系統: WINDOW7
軟體版本: Office 2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-16
最後登錄: 2017-3-14

熱烈參與勳章好學求知勳章

8^#

發表於 2012-5-21 15:43 | 只看該作者

回復 7# register313

謝謝大大
for to step 這各之前沒用過
看到附件才知道是count的數量是偶數或單數造成
學習了

字典兩各字還真難理解

Andy2483

　暱稱: 厚臉皮的學生

帖子: 1447
主題: 40
精華: 0
積分: 1471
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-12-5

9^#

發表於 2023-4-10 15:47 | 只看該作者

回復 1# freeffly

謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖練習陣列與字典,學習方案如下,請前輩參考,請各位前輩指教

執行前:

執行結果:

Option Explicit
Sub TEST()
Dim Brr, Y, i&, T$
Dim xR As Range, xU As Range
Set Y = CreateObject("Scripting.Dictionary")
Set xR = Range([A2], Cells(Rows.Count, "A").End(3)): Brr = xR
Set xU = [A1]
For i = 1 To UBound(Brr)
T = Brr(i, 1)
If Y(T) = "" Then Y(T) = Y.Count
If Y(T) Mod 2 = 0 Then Set xU = Union(xU, Cells(i + 1, 1))
Next
[A:A].Interior.ColorIndex = xlNone
xU.Interior.ColorIndex = 6
Set Y = Nothing: Set xR = Nothing: Erase Brr
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流