[發問] 不知道是否有辦法讓一樣的變成同一種顏色嗎??

a31075ha

範例圖:

下載 (197.9 KB)

2013-11-19 22:01

工單號碼的欄位是我們每天手動輸入的地方所以比較沒有規則性
而我主要是希望有程式碼能依照製品名稱一樣的自行變成同一種顏色並且回傳給工單號碼的欄位變成相同的顏色
因為有時一天會用到多達快10種顏色  只要能辨識出相同的一種顏色
是否能請大大綁忙 因為vba 這塊東湊西湊好像都做不太出來 ^^"
並請大大可否稍為幫我註解程式碼的用意
因為主要這樣表單好幾份 再不同檔案欄位位置都不太一樣  
這樣比較知道如何修改也順便學習  感恩各位大大................

a31075ha

回復  luhpro

大大我想請問如果其他欄位總共含隱藏的共有50幾欄
但是我想核對的為第11欄 然後一起變色 ...
a31075ha 發表於 2013-11-20 21:32

    感謝大大 研究出來了 ^^"

Private Sub cbSetColor_Click()
  Dim iI%
  Dim lRow&
  Dim sStr$
  Dim vColor, vD
  
  Set vD = CreateObject("Scripting.Dictionary")
  vColor = Array(34, 4, 45, 22, 26, 12, 8, 19, 24, 27, 38, 42, 44, 46, 0)
  iI = 0
  lRow = 5
  Do While Cells(lRow, 1) <> ""
    sStr = Cells(lRow, 11)
    If vD(sStr) = "" Then
      vD(sStr) = vColor(iI)
      iI = iI + 1
    End If
    Union(Cells(lRow, 7), Cells(lRow, 11)).Interior.ColorIndex = vD(sStr)
    lRow = lRow + 1
  Loop
End Sub

這樣就正常了

a31075ha

回復 2# luhpro

大大我想請問如果其他欄位總共含隱藏的共有50幾欄
但是我想核對的為第11欄 然後一起變色的昰第7欄 我修改這樣對嗎??
Private Sub cbSetColor_Click()
  Dim iI%
  Dim lRow&
  Dim sStr$
  Dim vColor, vD
  
  Set vD = CreateObject("Scripting.Dictionary")
  vColor = Array(34, 4, 45, 22, 26, 12, 8, 19, 24, 27, 38, 42, 44, 46, 0)
  iI = 0
  lRow = 5
  Do While Cells(lRow, 1) <> ""
    sStr = Cells(lRow, 50)
    If vD(sStr) = "" Then
      vD(sStr) = vColor(iI)
      iI = iI + 1
    End If
    Union(Cells(lRow, 7), Cells(lRow, 11)).Interior.ColorIndex = vD(sStr)
    lRow = lRow + 1
  Loop
End Sub

a31075ha

回復 2# luhpro


    謝謝你大大 最近做報表多虧大大你的幫忙.................

luhpro

回復 1# a31075ha

1. Private Sub cbSetColor_Click()
   
2.   Dim iI%
   
3.   Dim lRow&
   
4.   Dim sStr$
   
5.   Dim vColor, vD
   
6.   
   
7.   Set vD = CreateObject("Scripting.Dictionary")
   
8.   vColor = Array(34, 39, 43, 44, 36, 15)
   
9.   iI = 0
   
10.   lRow = 5
    
11.   Do While Cells(lRow, 1) <> ""
    
12.     sStr = Cells(lRow, 4)
    
13.     If vD(sStr) = "" Then
    
14.       vD(sStr) = vColor(iI)
    
15.       iI = iI + 1
    
16.     End If
    
17.     Union(Cells(lRow, 2), Cells(lRow, 4)).Interior.ColorIndex = vD(sStr)
    
18.     lRow = lRow + 1
    
19.   Loop
    
20. End Sub

複製代碼

SameColor-a.zip (10.01 KB)

下載次數: 12

2013-11-19 23:24