vba union用法

Question

http://www.funp.net/953491

向各位大師請益 union 的 range 判定 與 剔除用法

已更新項目:

依冰大程式碼測試，請冰大再幫忙

1.點擊B2→D3→F3

2.點擊B2→D3 OK

3.點擊F3 NG

...................剩1個,出現NG

2 個已更新項目:

請問准大, .Item(1) 改成 Target,結果一樣,功能有何不同????????

Set URng = .Item(1) -------> Set URng = Target

Set CRng = Intersect(URng, .Item(1)) ------> Set CRng = Intersect(URng, Target)

Set URng = Union(URng, .Item(1)) -----> Set URng = Union(URng, Target)

3 個已更新項目:

謝謝冰大.准大答覆,請准大移至回答區

Answer 1

最佳解答

＜參考檔＞：

http://www.funp.net/481293

2013-02-21 16:55:10 補充：

冰大：

測試一下：

若聯集為連續格〔A1:E5〕，再點中間任一格剔除之，例如：C3

2013-02-21 17:41:44 補充：

Set URng = .Item(1) -------> Set URng = Target

因已設為〔單選格〕才執行，所以一樣的，都可以！

建議千萬少使用SelectionChange，

若控制不好，不該執行的格子也會作用！

2013-02-21 17:55:04 補充：

這題不可直接使用〔聯集〕的ADDRESS〔字串〕當主角，

例如：A1.A2.A3的聯集位址為〔A1:A3〕，因此A2會被忽略！

2013-02-22 11:40:49 補充：

EXCEL VBA．〔Union 聯集儲存格〕成員的〔加入及移除〕

　　　　　　　　　　　　　　　　　　　　　　　　　＜．准提部林．＞

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

■主要功能：

　１．設一〔聯集儲存格〕共用變數。

　２．以〔滑鼠右鍵〕點選儲存格時：

　　　＞若該儲存格不包含在〔聯集〕時，將其〔加入〕聯集。

　　　＞若該儲存格已包含在〔聯集〕時，將其從聯集〔移除〕。

　

■程式碼：詳細註解請參閱範例檔

　Public URng As Range

　

　Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

　Dim CRng As Range, TRng As Range, xR As Range

　With Target

　　　　If .Count > 1 Or .Column > [J1].Column Then Exit Sub

　　　　Cancel = True

　　　　If URng Is Nothing Then Set URng = .Item(1): _

　　　　　.Interior.ColorIndex = 3: Exit Sub

　　　　Set CRng = Intersect(URng, .Item(1))

　　　　If CRng Is Nothing Then Set URng = Union(URng, .Item(1)): _

　　　　　.Interior.ColorIndex = 3: Exit Sub

　　　　Set TRng = URng: Set URng = Nothing

　　　　For Each xR In TRng

　　　　　　If xR.Address <> .Address Then

　　　　　　If URng Is Nothing Then Set URng = xR _

　　　　　　　　Else Set URng = Union(URng, xR)

　　　　　　Else

　　　　　　　　.Interior.ColorIndex = 0

　　　　　　End If

　　　　Next

　End With

　End Sub

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

＜範例檔＞下載：

檔案名稱：20130221a01(聯集儲存格的增減).rar

http://www.funp.net/481293

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

Answer 2

'要判別 TARGET 是否已在 UNION 中

'*******************************************判別程式碼

ss = InStr(UNRNG.Address, Target.Address)

''已在 UNION 中,表示重複選取 將 TARGET 從 UNION 中 剔除

'*******************************************剔除程式碼

If ss <> 0 Then

ss = IIf(ss = 1, 1, ss - 1)

2013-02-20 23:48:31 補充：

' 接上~

Set UNRNG = Range(Application.Replace(UNRNG.Address, ss, 5, ""))

Else

''未在 UNION 中,表示新RANGE 將 TARGET 加入 UNION 中

Set UNRNG = Union(UNRNG, Target) '*******加入程式碼

End If

2013-02-21 08:27:23 補充：

更正 002

' 接上~

Set UNRNG = Range(Application.Replace(UNRNG.Address, ss, Len(Target.Address)+1, ""))

Else

''未在 UNION 中,表示新RANGE 將 TARGET 加入 UNION 中

Set UNRNG = Union(UNRNG, Target) '*******加入程式碼

End If

2013-02-21 17:48:28 補充：

好像要去重修Range物件了