Excel VBA如何檢查_含有註解格數量

Andy2483

各位前輩好
1.請教 檢查_含有註解格數量 的程式碼
2.這程式的目的是為了檢查 因儲存格列大量刪除,而其它儲存格的註解實際位置跑得很遠,很不方便編輯註解
2.1.以下程式碼是自己想的土方法
3.有其它方法嗎?
4.Andy想進步!請指教

請各位前輩指教 謝謝

Sub 檢查_含有註解格數量()
Dim uR As Range, hascomN&, hascomAD$, msg$, hascomRng As Range
Dim L&, T&, hascomERRN&
On Error GoTo 101
hascomN = 0
msg = "沒有 註解格"
Set hascomRng = check_Area.SpecialCells(xlCellTypeComments)
On Error GoTo 0
On Error Resume Next
For Each uR In hascomRng
   If Not uR Is Nothing Then
      hascomN = hascomN + 1
      If hascomAD = "" Then
         hascomAD = uR.Address
         Else
            hascomAD = hascomAD & "," & uR.Address
      End If
      With uR.Comment.Shape
         L = .Left - (uR.Left + uR.Width + 200)
         T = .Top - (uR.Top + 50)
      End With
      If L > 0 Or T > 0 Then
         hascomERRN = hascomERRN + 1
      End If
   End If
Next
If hascomN > 20 Then
   If hascomERRN > 0 Then
      msg = "1.含有註解格太多!不顯示格位" & Chr(10) & "2.註解實際位置跑掉的格: " & hascomERRN & " 個"
      Else
         msg = "1.含有註解格太多!不顯示格位" & Chr(10) & "2.沒有註解實際位置跑掉的格"
   End If
   ElseIf hascomN <> 0 Then
      If hascomERRN > 0 Then
         msg = "1.有註解儲存格格位: " & hascomAD & Chr(10) & "2.註解實際位置跑掉的格: " & hascomERRN & " 個"
         Else
            msg = "1.有註解儲存格格位: " & hascomAD & Chr(10) & "2.沒有註解實際位置跑掉的格"
      End If
   Else
      msg = "沒有 註解格"
End If

101
ck_K = "檢查_含有註解格數量"
ck_Q = hascomN
ck_W = msg
If hascomERRN > 0 Then
   ck_AC = "程式可以自動調整註解位置"
   Call 設清單_I欄
   Call 當列上色
   
   Else
      ck_AC = "NA"
End If
On Error GoTo 0
End Sub

ikboy

1. Sub zz()
   
2. Dim s$, c As Object
   
3. With ActiveSheet
   
4.     For i = 1 To .Comments.Count
   
5.         Set c = .Comments(i)
   
6.         s = s & Chr(10) & "Comment " & i & Chr(10) & "Location " & c.Parent.Address(0, 0) _
   
7.         & Chr(10) & "Contents " & Chr(10) & c.Text & Chr(10) & String(20, "*")
   
8.     Next
   
9. End With
   
10. Debug.Print s
    
11. End Sub

複製代碼

Andy2483

回復 2# ikboy
收到 謝謝前輩指導
星期一才有辦法用PC做測試 學習

Andy2483

回復 2# ikboy


ikboy前輩您好
1.測試結果跟想要的結果不一樣,Andy沒有表達清楚!抱歉
2您提供的程式碼沒看過 感覺很艱深!恐怕不是Andy這等學淺的看得懂的
   如果您有空 請再指導 標註一下程式碼的意思 謝謝您
3.上傳範例檔表達情境,請前輩們再指導
20200810_1.rar (12.44 KB)

下載次數: 5

2020-8-10 07:57

n7822123

回復 4# Andy2483

1.測試結果跟想要的結果不一樣,Andy沒有表達清楚!抱歉

他回了重點寫法，但是沒有套用到你要的功能

這個論壇有些人只回"重點"，你要能適應，並且要能看懂別人的寫法

我是比較囉嗦的人(耐心打字)，其他人可不一定;P


2.如果您有空 請再指導 標註一下程式碼的意思 謝謝您

有上註解了，看不懂再問!


3.上傳範例檔表達情境,請前輩們再指導

結合ikboy 與 你原本的程式 給你

程式如下

Sub 檢查_含有註解格數量_New()
Dim hascomN&, msg1$, msg2$, L&, T&, hascomERRN&
Dim uR As Range, com As Comment
msg1 = "1.有註解儲存格格位: "
For Each com In ActiveSheet.Comments   '此活工作表 註解'集合'
  With com  '針對所有註解
    hascomN = hascomN + 1  '計算
    msg1 = msg1 & .Parent.Address  '對應的儲存格位置
    Set uR = Range(.Parent.Address)  '指定該儲存格物件
    L = .Shape.Left - (uR.Left + uR.Width + 200)  '你原本的規則
    T = .Shape.Top - (uR.Top + 50)                         '你原本的規則
    If L > 0 Or T > 0 Then hascomERRN = hascomERRN + 1  '累加不合規則的註解數
  End With
Next
If hascomN > 20 Then msg1 = "1.含有註解格太多!不顯示格位"     '你原本的規則
msg2 = "2.註解實際位置跑掉的格:" & hascomERRN & " 個"
If hascomERRN = 0 Then msg2 = "2.沒有註解實際位置跑掉的格"  '你原本的規則
MsgBox msg1 & Chr(10) & msg2
End Sub

Sub 註解_調整至指定位置_New()
Dim com As Comment, SetLeft&, SetTop&
Const L = 20: Const T = 20   '你原本的規則
For Each com In ActiveSheet.Comments  '此活工作表 註解'集合'
  With com   '針對所有註解
    With Range(.Parent.Address)     '指定該儲存格物件
      SetLeft = .Left + .Width + L   '你原本的規則
      SetTop = .Top + T                   '你原本的規則
    End With
    With .Shape: .Left = SetLeft: .Top = SetTop: End With  '設定註解位置
  End With
Next
Application.DisplayCommentIndicator = 1   '顯示註解和指標
End Sub

修改你的範例檔 如下

20200810_new.rar (22.59 KB)

下載次數: 9

2020-8-10 22:25

n7822123

回復 4# Andy2483


補充一下，你的寫法是用儲存格找註解

ikboy 是用 註解找儲存格

Andy2483

回復 5# n7822123


    謝謝前輩指導
1.認識了 Parent 的概念
MsgBox ActiveCell.Comment.Parent.Address
MsgBox ActiveCell.Parent.Name
MsgBox ActiveSheet.Parent.Name

2.Option Explicit    以後也會養成習慣

3.再請教前輩 網查 Const 是常數的意思,有用它跟沒用都可以執行
3.1.在程式的設計上 Const 有甚麼時候是非用不可呢? 請您再指導
Const L = 20: Const T = 20

Dim  L&, T&
L = 20:  T = 20

GBKEE

回復 7# Andy2483

3.再請教前輩 網查 Const 是常數的意思,有用它跟沒用都可以執行
3.1.在程式的設計上 Const 有甚麼時候是非用不可呢? 請您再指導
Const L = 20: Const T = 20

    Const 指定變數固定的內容 最好加註說明 ,當程式寫的龐大時如修改變數內容,只需修改這裡.
n7822123 , ikboy 的回覆多加練習,不懂可多看說明,再提問會進步的
下面的程式參考看看

1. Option Explicit
   
2. '365 之前版本只有 Comment 物件 為[註解]
   
3. '365 版本中             Comment  物件 為[附註]
   
4. '365 版本中 新增CommentThreaded 物件 為[註解]
   
5. Sub Ex註解()
   
6.     Dim Msg As String
   
7.     With ActiveSheet
   
8.         If .Comments.Count > 0 Then Msg = "[附註]   有" & .Comments.Count & "個 " & 註解副程式(.Comments)
   
9.         If Application.Version >= 16 Then   '版本365以上
   
10.              If Msg <> "" Then Msg = Msg & vbLf & vbLf
    
11.             If .CommentsThreaded.Count >= 0 Then Msg = Msg & "[註解]   有" & .CommentsThreaded.Count & "個 " & 註解副程式(.CommentsThreaded)
    
12.         End If
    
13.         If Msg = "" Then Msg = .Name & " 沒有任何 註解...."
    
14.         MsgBox Msg
    
15. End With
    
16. End Sub
    
17. Function 註解副程式(comm As Object) As String
    
18.     Dim e As Object, 註解 As String
    
19.     For Each e In comm
    
20.         If TypeName(e) = "CommentThreaded" Then   '版本365以上
    
21.             註解 = 註解 & IIf(註解 <> "", vbLf, "") & e.Parent.Cells.Address & "  " & e.Text
    
22.         Else ' 版本365以下
    
23.             註解 = 註解 & IIf(註解 <> "", vbLf, "") & e.Shape.TopLeftCell.Address & "  " & e.Text
    
24.         End If
    
25.     Next
    
26.     註解副程式 = vbLf & 註解
    
27. End Function

複製代碼

ikboy

回復 4# Andy2483
@Andy2483
幾天沒來, 沒想到有那麼多訊息, 首先我在 2#回帖時, 我基本沒有耐心去解讀你的代碼, 原本是想按主題 -  Excel VBA如何檢查_含有註解格數量, 回覆一句代碼

1. Debug.print Activesheet.comments.count

複製代碼

但似乎對你實際需要沒甚幫助, 不如將之以物件形式表示出其屬性, 這就是我在2/F回帖目的。
@n7822123
多謝及佩服你在5/F的眼光
最後多謝GBKEE版大的各項提點。

Andy2483

回復 8# GBKEE


    謝謝前輩指導
1.Const 指定變數固定的內容
1.1.以前都用副程式的方式呼叫這常數
1.2.運用Const 放在模組上方
1.2.1.做為全域常數
1.2.2.也可在Code裡,但意義不同
以上學習心得 如有前輩可指導 請不吝指導

以前的土方法
Option Explicit
Public 存款利率 As Double
Sub 定義存款利率()
存款利率 = 0.03
End Sub

Sub 普通存款利率()
Call 定義存款利率
MsgBox 存款利率
End Sub

Sub 優惠存款利率()
Call 定義存款利率
MsgBox 存款利率 * 1.1
End Sub

Sub 大額存款超優利率()
Call 定義存款利率
MsgBox 存款利率 * 1.5
End Sub

Sub 董事特超優利率別()
Dim 存款利率 As Double
存款利率 = 0.06
MsgBox 存款利率
Call 普通存款利率
Call 優惠存款利率
Call 大額存款超優利率
End Sub

'運用Const
Option Explicit
Const 存款利率 = 0.03
Sub 普通存款利率()
MsgBox 存款利率
End Sub

Sub 優惠存款利率()
MsgBox 存款利率 * 1.1
End Sub

Sub 大額存款超優利率()
MsgBox 存款利率 * 1.5
End Sub

Sub 董事特超優利率別()
Const 存款利率 = 0.06 '可以另外定義此常數
MsgBox 存款利率
Call 普通存款利率 '但不影響全域的 存款利率 = 0.03
Call 優惠存款利率
Call 大額存款超優利率
End Sub

2.Function一直式跨不過去的門檻
2.1.Andy 愚鈍需要較長時間研習
2.2.前輩提供的範例是自己的題材,希望藉此能跨過

謝謝各位前輩指導
您的指導如果沒有即時回應: 研習中或不方便回應(工作忙.沒有PC可測試....)