返回列表 上一主題 發帖

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

freeffly

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

熱烈參與勳章好學求知勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2012-5-11 09:36 | 只看該作者

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

本帖最後由 freeffly 於 2012-5-11 13:13 編輯

以前在一般區問過同樣問題
如何同一區塊相同資料標顏色
不過資料多的時候會發生excel當掉的感覺
不知道是不是持續運算的關係
如果改成用vba要如何寫?
A欄要做像D欄那樣的效果

Test.rar (11.36 KB)
收藏 分享
字典兩各字 還真難理解

Andy2483
　暱稱: 厚臉皮的學生

碩士班Rank: 5Rank: 5

帖子
1567 
主題
40 
精華
0 
積分
1591 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
100 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2026-2-2 
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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

freeffly

帖子
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的數量是偶數或單數造成
   學習了
字典兩各字 還真難理解

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
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)

TOP

freeffly

帖子
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也可行
  1. For R = 0 To d.Count - 1 Step 2
複製代碼
或是原代碼1改為0也行
  1. For R = 1 To d.Count  Step 2
複製代碼
大大新的代碼是這各 還有Dim Ar
  1. For R = 1 To d.Count - 1 Step 2
複製代碼
作了之後標顏色區塊有點不一樣 可是會同樣效果
   也不會出現陣列超出範圍
   為什麼會有差異?
字典兩各字 還真難理解

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
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
不是列數限制
之前程式稍作修正
  1. Sub xx()
  2. Dim d As Object
  3. Dim Rng As Range
  4. Dim Ar
  5. Columns("A").Interior.ColorIndex = 0
  6. Set d = CreateObject("Scripting.Dictionary")
  7. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  8.   d(A.Value) = A.Value
  9. Next
  10. Ar = d.Items
  11. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  12.   For R = 1 To d.Count - 1 Step 2
  13.       If A = Ar(R) Then
  14.       If Rng Is Nothing Then
  15.         Set Rng = A
  16.       Else
  17.         Set Rng = Union(Rng, A)
  18.       End If
  19.     End If
  20.   Next R
  21. Next
  22. Rng.Interior.ColorIndex = 6
  23. End Sub
複製代碼

TOP

freeffly

帖子
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)
字典兩各字 還真難理解

TOP

freeffly

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

熱烈參與勳章好學求知勳章
3#
發表於 2012-5-11 13:12 | 只看該作者
回復 2# register313


    謝謝
   字典的對我來說還很難
   感覺比文言文還難
字典兩各字 還真難理解

TOP

register313
　頭銜: 麻辣 路人甲

大學生Rank: 4

帖子
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欄必須要排序
  1. Sub xx()
  2. Dim d As Object
  3. Dim Rng As Range
  4. Columns("A").Interior.ColorIndex = 0
  5. Set d = CreateObject("Scripting.Dictionary")
  6. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  7.   d(A.Value) = A.Value
  8. Next
  9. Ar = d.Items
  10. For Each A In Range("A2:A" & [A65536].End(xlUp).Row)
  11.   For R = 0 To d.Count Step 2
  12.     If A = Ar(R) Then
  13.       If Rng Is Nothing Then
  14.         Set Rng = A
  15.       Else
  16.         Set Rng = Union(Rng, A)
  17.       End If
  18.     End If
  19.   Next R
  20. Next
  21. Rng.Interior.ColorIndex = 6
  22. End Sub
複製代碼

TOP

        靜思自在 : 時時好心就是時時好日。
返回列表 上一主題