執行時:right click-> Delete...->Shift cells up|left在選定的單元格上。Target傳遞給的范圍Worksheet.Change僅反映選擇,而不是向上或向左移動的單元格。
問題說明(抱歉,我無法從這臺計算機上傳影像):
假設我的作業表中有以下單元格:
| # | 一個 | 乙 | C | D |
|---|---|---|---|---|
| 1 | 1 | 1 | 1 | 1 |
| 2 | 2 | 2 | 2 | 2 |
| 3 | 3 | 3 | 3 | 3 |
如果我要選擇范圍B1:C1并執行:right click-> Delete...->Shift cells up
作業表現在看起來像這樣: | # |A|B|C|D| |-:|:-:|:-:|:-:|:-:| | 1 |1|2|2|1| | 2 |2|3|3|2| | 3 |3| | |3|
根據Worksheet.Change事件:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Debug.Print Target.Address
End Sub
已更改的單元格是$B$1:$C$1(原始選擇)。
但是,很明顯單元格$B$1:$C$3發生了變化(從技術上講,B 列和 C 列中的所有單元格都可能發生了變化,但我對此不感興趣)。
是否有一種干凈有效的方法來檢測已更改的最小單元格范圍?
我已經做了幾次嘗試,比如在選擇更改時跟蹤使用的范圍,并將以前使用的范圍與當前使用的范圍的“凸包”和Target. 但它們要么都非常慢,要么不能處理一些邊緣情況。
uj5u.com熱心網友回復:
該Worksheet.Change事件對于觸發它的內容非常具體:只要單元格的公式/值發生更改,它就會觸發。當您洗掉單元格并向上移動時,下面的單元格不會更改,但它們會更改 - 可以通過即時Address工具視窗中的幾行來證明:
set x = [A2]
[A1].delete xlshiftup
?x.address
$A$1
由于 Excel 物件模型中的任何內容都不會跟蹤地址更改,因此您只能在此處進行操作。
這里的挑戰是Range("B1")總是會回傳一個全新的物件指標,所以你不能使用Is運算子來比較物件參考;Range("B1") Is Range("B1")永遠是False:
?objptr([B1]),objptr([B1]),objptr([B1])
2251121322704 2251121308592 2251121315312
2251121313296 2251121308592 2251121310608
2251121315312 2251121322704 2251121308592
指標地址確實會重復出現,但它們并不可靠,并且不能保證另一個單元格不會在另一個呼叫中占據那個位置 - 事實上這似乎很可能,因為我在第一次嘗試時遇到了沖突:
?objptr([B2])
2251121322704
所以我們需要一個小資料結構來幫助我們 - 讓我們添加一個新的TrackedCell類模塊,我們可以Range在同一個物件上獨立于參考存盤地址。
問題是我們正在洗掉Range單元格,因此如果我們嘗試訪問它,封裝的參考將拋出錯誤 424“需要物件” - 但這是我們可以充分利用的有用資訊:
Private mOriginalAddress As String
Private mCell As Range
Public Property Get CurrentAddress() As String
On Error Resume Next
CurrentAddress = mCell.Address()
If Err.Number <> 0 Then
Debug.Print "Cell " & mOriginalAddress & " object reference is no longer valid"
Set mCell = Nothing '<~ that pointer is useless now, but IsNothing is useful information
End If
On Error GoTo 0
End Property
Public Property Get HasMoved() As Boolean
HasMoved = CurrentAddress <> mOriginalAddress And Not mCell Is Nothing
End Property
Public Property Get Cell() As Range
Set Cell = mCell
End Property
Public Property Set Cell(ByVal RHS As Range)
Set mCell = RHS
End Property
Public Property Get OriginalAddress() As String
OriginalAddress = mOriginalAddress
End Property
Public Property Let OriginalAddress(ByVal RHS As String)
mOriginalAddress = RHS
End Property
回到Worksheet模塊中,我們現在需要一種方法來獲取這些單元格參考。Worksheet.Activate可以作業,但Worksheet.SelectionChange應該更嚴格:
Option Explicit
Private Const TrackedRange As String = "B1:C42" '<~ specify the tracked range here
Private TrackedCells As New VBA.Collection '<~ As New will never be Nothing
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set TrackedCells = New VBA.Collection '<~ wipe whatever we already got
Dim Cell As Range
For Each Cell In Me.Range(TrackedRange)
Dim TrackedCell As TrackedCell
Set TrackedCell = New TrackedCell
Set TrackedCell.Cell = Cell
TrackedCell.OriginalAddress = Cell.Address
TrackedCells.Add TrackedCell
Next
End Sub
所以現在我們知道被跟蹤的單元格在哪里,我們準備好處理Worksheet.Change:
Private Sub Worksheet_Change(ByVal Target As Range)
Debug.Print "Range " & Target.Address & " was modified"
Dim TrackedCell As TrackedCell
For Each TrackedCell In TrackedCells
If TrackedCell.HasMoved Then
Debug.Print "Cell " & TrackedCell.OriginalAddress & " has moved to " & TrackedCell.CurrentAddress
End If
Next
End Sub
要對此進行測驗,您需要先選擇作業表上的任何單元格(以運行SelectionChange處理程式),然后您可以嘗試在即時工具視窗中洗掉一個單元格:
[b3].delete xlshiftup
Range $B$3 was modified
Cell $B$3 object reference is no longer valid
Cell $B$4 has moved to $B$3
Cell $B$5 has moved to $B$4
Cell $B$6 has moved to $B$5
Cell $B$7 has moved to $B$6
Cell $B$8 has moved to $B$7
Cell $B$9 has moved to $B$8
Cell $B$10 has moved to $B$9
Cell $B$11 has moved to $B$10
Cell $B$12 has moved to $B$11
Cell $B$13 has moved to $B$12
Cell $B$14 has moved to $B$13
Cell $B$15 has moved to $B$14
Cell $B$16 has moved to $B$15
Cell $B$17 has moved to $B$16
Cell $B$18 has moved to $B$17
Cell $B$19 has moved to $B$18
Cell $B$20 has moved to $B$19
Cell $B$21 has moved to $B$20
Cell $B$22 has moved to $B$21
Cell $B$23 has moved to $B$22
Cell $B$24 has moved to $B$23
Cell $B$25 has moved to $B$24
Cell $B$26 has moved to $B$25
Cell $B$27 has moved to $B$26
Cell $B$28 has moved to $B$27
Cell $B$29 has moved to $B$28
Cell $B$30 has moved to $B$29
Cell $B$31 has moved to $B$30
Cell $B$32 has moved to $B$31
Cell $B$33 has moved to $B$32
Cell $B$34 has moved to $B$33
Cell $B$35 has moved to $B$34
Cell $B$36 has moved to $B$35
Cell $B$37 has moved to $B$36
Cell $B$38 has moved to $B$37
Cell $B$39 has moved to $B$38
Cell $B$40 has moved to $B$39
Cell $B$41 has moved to $B$40
Cell $B$42 has moved to $B$41
似乎在這里作業得很好,細胞數量有限。我不會在整個作業表(或其UsedRange)上運行它,但它給出了如何去做的想法。
轉載請註明出處,本文鏈接:https://www.uj5u.com/qiye/515449.html
標籤:擅长vba
上一篇:VBA如何在函式中設定表單
