- 帖子
- 4901
- 主題
- 44
- 精華
- 24
- 積分
- 4916
- 點名
- 256
- 作業系統
- Windows 7
- 軟體版本
- Office 20xx
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台北
- 註冊時間
- 2010-4-30
- 最後登錄
- 2024-11-26
              
|
32#
發表於 2010-7-11 23:12
| 只看該作者
回復 22# PD961A
既然不想多一欄輸入公式,而採用VBA,又怕顏色太亂,又要知道哪幾格重複,那就用註解物件儲存如何?- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Rng As Range, A As Range, d As Object
- Set d = CreateObject("Scripting.Dictionary")
- If Target.Column <> 7 Then Exit Sub
- For Each A In Range("G13:G65536").SpecialCells(xlCellTypeConstants)
- If Application.CountIf(Columns("G"), A) > 1 Then
- If IsEmpty(d(A.Value)) Then
- Set d(A.Value) = A
- Else
- Set d(A.Value) = Union(d(A.Value), A)
- End If
- End If
- Next
- For Each A In Range("G:G").SpecialCells(xlCellTypeConstants)
- If Not IsEmpty(d(A.Value)) Then
- For Each Rng In d(A.Value)
- If Rng.Comment Is Nothing Then
- Rng.AddComment.Text Text:=d(A.Value).Address(0, 0)
- Else
- Rng.Comment.Text Text:=d(A.Value).Address(0, 0)
- End If
- Next
- End If
- Next
- End Sub
|
|
發表於 2010-7-11 19:10
| 
