標題: [發問] 怎麼取有顏色儲存格內的值 [打印本頁]

---

作者: sunland    時間: 2014-8-14 13:09     標題: 怎麼取有顏色儲存格內的值

[attach]18901[/attach]

請教大大們,
如何寫一個vba 或是macro 輸入儲存格的顏色(粉色),將sheet中相同顏色(粉色\欄位),然後複製到另一個sheet 中.
     請大大們指導.

---

作者: GBKEE    時間: 2014-8-14 14:49

本帖最後由 GBKEE 於 2014-8-14 14:55 編輯

回復 1# sunland


[attach]18902[/attach]


試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim A As Range, A_Po As String
   
4.     Dim AA As Range
   
5.    
   
6.     'FindFormat 屬性 設定或傳回要尋找之儲存格格式類型的搜尋準則。
   
7.     With Application.FindFormat
   
8.         .Clear                      '清除以前的設定
   
9.        ' .Interior.Color = vbred    '設定儲存格圖樣顏色(紅色)
   
10.         .Interior.ColorIndex = 3   '設定儲存格圖樣顏色(紅色)
    
11.        '.Font.Bold = True           '粗體
    
12.        '.Font.Size = 12             '字型大小
    
13.     End With
    
14.    
    
15.     Set A = Cells.Find("", AFTER:=Cells(Cells.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
    
16.     Do While Not A Is Nothing
    
17.         If A_Po = "" Then
    
18.             A_Po = A.Address
    
19.             Set AA = A
    
20.         End If
    
21.         Set AA = Union(AA, A)
    
22.         Set A = Cells.Find(What:="", AFTER:=A, SearchFormat:=True) '下一個相同格式搜尋
    
23.         If A_Po = A.Address Then Exit Do
    
24.     Loop
    
25.     If Not A Is Nothing Then AA.Copy Sheets("目標工作表").Range("A1")
    
26. End Sub
    
27. Sub Ex_A()  '找顏色 ColorIndex 可如此得到
    
28.     MsgBox Range("A1").Interior.ColorIndex
    
29. End Sub

複製代碼

---

作者: sunland    時間: 2014-8-14 17:25

謝謝大大幫忙.

我執行後有出現下列訊息,我要再修改何處?

[attach]18906[/attach]

---

作者: sunland    時間: 2014-8-14 17:52

我試著用MACRO錄製有成功取的儲存格(紅色)的值.
單一行可以成功,那多行的話要怎麼修改取的多行的值.
請大大再次指導
[attach]18907[/attach]
[attach]18908[/attach]

1. Sub Macro7()
   
2. '
   
3.      With Application.FindFormat.Interior
   
4.         .PatternColorIndex = xlAutomatic
   
5.         .Color = 255
   
6.         .TintAndShade = 0
   
7.         .PatternTintAndShade = 0
   
8.     End With
   
9.     Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
   
10.         xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
    
11.         , SearchFormat:=True).Activate
    
12.     Sheets("Sheet1").Select
    
13.     Range("A8:AJ8").Select
    
14.     Selection.Copy
    
15.     Sheets("Sheet2").Select
    
16.     ActiveSheet.Paste
    
17. End Sub

複製代碼

---

作者: GBKEE    時間: 2014-8-14 19:10

回復 4# sunland

再試試看

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim A As Range, A_Po As String
   
4.     Dim AA As Range, Sh As Worksheet
   
5.    
   
6.     'FindFormat 屬性 設定或傳回要尋找之儲存格格式類型的搜尋準則。
   
7.     With Application.FindFormat
   
8.         .Clear                      '清除以前的設定
   
9.        ' .Interior.Color = vbred    '設定儲存格圖樣顏色(紅色)
   
10.         .Interior.ColorIndex = 3   '設定儲存格圖樣顏色(紅色)
    
11.        '.Font.Bold = True           '粗體
    
12.        '.Font.Size = 12             '字型大小
    
13.     End With
    
14.     Set Sh = ActiveSheet
    
15.     Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
    
16.     Do While Not A Is Nothing
    
17.         If A_Po = "" Then
    
18.             A_Po = A.Address
    
19.             Set AA = A
    
20.         End If
    
21.         Set AA = Union(AA, A)
    
22.         Set A = Sh.Cells.Find(What:="", AFTER:=A, SearchFormat:=True) '下一個相同格式搜尋
    
23.         If A_Po = A.Address Then Exit Do
    
24.     Loop
    
25.     If Not A Is Nothing Then AA.Copy Sheets("目標工作表").Range("A1")
    
26. End Sub

複製代碼

---

作者: sunland    時間: 2014-8-15 08:09

出現相同的錯誤,  我使用的是excel 2007 不知道有沒有關連?

---

作者: GBKEE    時間: 2014-8-15 09:08

回復 6# sunland
出現相同的錯誤
可否上傳如這顯示錯誤的畫面
或是錯誤碼


[attach]18916[/attach]

---

作者: sunland    時間: 2014-8-15 11:43

大大請再過目.
謝謝

[attach]18921[/attach]

---

作者: luhpro    時間: 2014-8-16 09:01

回復 8# sunland

你可以點一下 "偵錯" 按鈕,
它會告訴你發生溢位的是哪個變數.
再將該變數的資料型態調大, (變更 Dim 的變數宣告型態)
我猜測是你使用來表示列號的變數型態設太小了 (如 : Integer)
用於列號的變數建議設為 Long 的型態.

---

作者: c_c_lai    時間: 2014-8-16 16:46

本帖最後由 c_c_lai 於 2014-8-16 16:49 編輯

回復 7# GBKEE

1.     Set Sh = ActiveSheet
   
2.     ' Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
   
3.     Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(1), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。

複製代碼

Sh.Cells(Sh.Cells.Count)=<溢位>
改成Sh.Cells(1) 便 OK 了。

---

作者: GBKEE    時間: 2014-8-16 19:33

回復 8# sunland
回復 10# c_c_lai

那改為如此比較恰當,最後一個儲存格找起

1.     Set Sh = ActiveSheet
   
2.     '2003-> Sh.Cells.Count 是沒錯誤的
   
3.      ' Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
   
4. 
   
5.     Set a = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Rows.Count, Sh.Cells.Columns.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。

複製代碼

---

作者: sunland    時間: 2014-8-18 09:05

感謝各位大大的幫忙, 試了多次終於成功.
待取的紅色儲存格
[attach]18946[/attach]
取的紅色儲存格
[attach]18947[/attach]

1. Option Explicit
   
2. 
   
3. Sub Ex()
   
4. 
   
5.     Dim A As Range, A_Po As String
   
6.     Dim AA As Range, Sh As Worksheet
   
7.    
   
8.     'FindFormat 屬性 設定或傳回要尋找之儲存格格式類型的搜尋準則。
   
9. 
   
10.     With Application.FindFormat
    
11. 
    
12.         .Clear                      '清除以前的設定
    
13. 
    
14.         .Interior.Color = vbRed    '設定儲存格圖樣顏色(紅色)
    
15. 
    
16.        ' .Interior.ColorIndex = 3   '設定儲存格圖樣顏色(紅色)
    
17. 
    
18.        '.Font.Bold = True           '粗體
    
19. 
    
20.        '.Font.Size = 12             '字型大小
    
21. 
    
22.     End With
    
23. 
    
24.     'Set Sh = ActiveSheet
    
25. 
    
26.     'Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
    
27.    
    
28.         Set Sh = ActiveSheet
    
29. 
    
30.     '2003-> Sh.Cells.Count 是沒錯誤的
    
31.      ' Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
    
32. 
    
33. 
    
34.     Set A = Sh.Cells.Find("", AFTER:=Sh.Cells(Sh.Cells.Rows.Count, Sh.Cells.Columns.Count), SearchFormat:=True) 'SearchFormat   選擇性的 Variant。搜尋的格式。
    
35.    
    
36.    
    
37.    
    
38. 
    
39.     Do While Not A Is Nothing
    
40. 
    
41.         If A_Po = "" Then
    
42. 
    
43.             A_Po = A.Address
    
44. 
    
45.             Set AA = A
    
46. 
    
47.         End If
    
48. 
    
49.         Set AA = Union(AA, A)
    
50. 
    
51.         Set A = Sh.Cells.Find(What:="", AFTER:=A, SearchFormat:=True)  '下一個相同格式搜尋
    
52. 
    
53.         If A_Po = A.Address Then Exit Do
    
54. 
    
55.     Loop
    
56. 
    
57.     If Not A Is Nothing Then AA.Copy Sheets("Sheet2").Range("A1")
    
58. 
    
59. End Sub

複製代碼

儲存格的顏色用 .Interior.Color = vbRed    '設定儲存格圖樣顏色(紅色) ,就能找到.
但用' .Interior.ColorIndex = 3   '設定儲存格圖樣顏色(紅色) 就失敗(找不到相關顏色.)
如果是用能 input = 顏色 代入當變數 可行嗎? 應該怎麼做?
請再次指導.
感謝

---

作者: sunland    時間: 2014-8-18 09:22

我真是太不用心了,大大在一開始就指導怎麼抓color code,
更新一下.

這下全部都解決了~問題.
謝謝

1.   Sub Ex_A()  '找顏色 ColorIndex 可如此得到
   
2. 
   
3.   MsgBox Range("A1").Interior.ColorIndex  '抓色
   
4.   MsgBox Range("A1").Interior.Color    '抓色值
   
5. 
   
6. End Sub

複製代碼

---

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