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

範例圖:

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

樓主熱帖

luhpro

高中生 Rank: 3 Rank: 3

帖子: 824
主題: 6
精華: 0
積分: 904
點名: 0
作業系統: Win 10,7
軟體版本: 2019,2013,2003
閱讀權限: 50
性別: 男
註冊時間: 2010-5-3
最後登錄: 2023-12-24

2^#

發表於 2013-11-19 23:24 | 只看該作者

回復 1# a31075ha

Private Sub cbSetColor_Click()
Dim iI%
Dim lRow&
Dim sStr$
Dim vColor, vD
Set vD = CreateObject("Scripting.Dictionary")
vColor = Array(34, 39, 43, 44, 36, 15)
iI = 0
lRow = 5
Do While Cells(lRow, 1) <> ""
sStr = Cells(lRow, 4)
If vD(sStr) = "" Then
vD(sStr) = vColor(iI)
iI = iI + 1
End If
Union(Cells(lRow, 2), Cells(lRow, 4)).Interior.ColorIndex = vD(sStr)
lRow = lRow + 1
Loop
End Sub

複製代碼

SameColor-a.zip (10.01 KB)

TOP

a31075ha

中學生 Rank: 2

帖子: 39
主題: 8
精華: 0
積分: 53
點名: 0
作業系統: WIN7
軟體版本: 2003
閱讀權限: 20
註冊時間: 2013-11-16
最後登錄: 2016-1-30

3^#

發表於 2013-11-20 21:18 | 只看該作者

回復 2# luhpro

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

TOP

a31075ha

中學生 Rank: 2

帖子: 39
主題: 8
精華: 0
積分: 53
點名: 0
作業系統: WIN7
軟體版本: 2003
閱讀權限: 20
註冊時間: 2013-11-16
最後登錄: 2016-1-30

4^#

發表於 2013-11-20 21:32 | 只看該作者

回復 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

TOP

a31075ha

中學生 Rank: 2

帖子: 39
主題: 8
精華: 0
積分: 53
點名: 0
作業系統: WIN7
軟體版本: 2003
閱讀權限: 20
註冊時間: 2013-11-16
最後登錄: 2016-1-30

5^#

發表於 2013-11-20 21:56 | 只看該作者

回復 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

這樣就正常了

TOP