返回列表下一主題上一主題發帖

[發問] 新增規則問題(或有更好的解決方式)?

luiroger

中學生 Rank: 2

帖子: 5
主題: 3
精華: 0
積分: 55
點名: 0
作業系統: WIN10
軟體版本: Office 2019
閱讀權限: 20
性別: 男
註冊時間: 2020-6-22
最後登錄: 2023-5-6

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-3-13 19:18 | 只看該作者

[發問] 新增規則問題(或有更好的解決方式)?

第一次發帖,請多擔待~
想請問,範例簡要如下,第一欄屬於料號,第2欄屬於LOT,
規則描述:料號可以有很多不同的LOT,但是同一個LOT只能對應到1個料號,
如果LOT對應到兩個(以上)料號,必須用紅字顯示,
還有VBA如何找到被規則列為紅字的儲存格呢,
我想用VBA直接幫使用者SELECT到該儲存格的位置,
或事件發生時提醒使用者--->一個LOT對應到"多"個料號,
還望高手們不吝解答~
有更好的解決方案更好(上網GOOGLE好像有看到dictionary,
但是目前看不懂=.=)

料號 LOT
A 1
A 2
A 3
B 4
B 5
C 6
C 7
D 8
D 9
D 0
E 1

問題.rar (7.08 KB)

問題.rar (7.07 KB)

樓主熱帖

luhpro

高中生 Rank: 3 Rank: 3

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

2^#

發表於 2021-3-15 23:06 | 只看該作者

本帖最後由 luhpro 於 2021-3-15 23:23 編輯

第一次發帖,請多擔待~
想請問,範例簡要如下,第一欄屬於料號,第2欄屬於LOT,
規則描述:料號可以有很多不同的 ...
luiroger 發表於 2021-3-13 19:18

Dictionary 指令在 "逐個" (比對或尋找) "多組" (相同或相異) 資料上滿好用的:

Sub nn()
Dim lRow&
Dim dLot, dRow
[A1].CurrentRegion.Interior.ColorIndex = -4142 ' 清空底色
Set dLot = CreateObject("Scripting.Dictionary") ' 定義要儲存 LOT 的字典
Set dRow = CreateObject("Scripting.Dictionary") ' 定義要儲存列號的字典
lRow = 2 ' 初始列號
While Cells(lRow, 1) <> "" ' 迴圈至資料最末
With Cells(lRow, 1) ' 以 A 欄為主體
If dLot.Exists(.Offset(, 1).Text) Then ' 如果已有相同 LOT 則
.Font.ColorIndex = 3 ' 本列 A 欄設紅色
.Offset(-lRow + dRow(.Offset(, 1).Text)).Font.ColorIndex = 3 ' 上次同 LOT 列的 A 欄設紅色
' -lRow + dRow(.Text) 是增量計算列號位移技巧: .offset(-現在列號)=[A0], 再加上上次儲存的列號就指向上次同 LOT A欄儲存格
.Select ' 移動到同 LOT A欄儲存格
End If
dLot(.Offset(, 1).Text) = .Text ' 儲存此 LOT 對應的料號, 以便後續比對是否有相同 LOT 出現
dRow(.Offset(, 1).Text) = lRow ' 儲存此 LOT 的列號, 以便若比對出相同 LOT 時,可以一併設定紅色
End With
lRow = lRow + 1 ' 列號加 1
Wend
End Sub

複製代碼

問題-ans.zip (13.79 KB)
簡述 :
lRow = 2 時,
dLot("1") 沒資料, 所以 If 內指令不執行, 後面
dLot("1") = "A"
dRow("1") = 2 (底下比照辦理)

直到 lRow = 12 時,
因之前已設定 dLot("1") = "A", 所以 If 內指令會執行:
[B12] 與 [B2] 都設定紅色, 後面
dLot("1") = "E"
dRow("1") = 12 (餘略)

TOP

luiroger