麻辣家族討論版版 - Powered by Discuz! Board

標題: Excel VBA如何檢查_含有註解格數量 [打印本頁]

作者: Andy2483 時間: 2020-8-6 16:19 標題: Excel VBA如何檢查_含有註解格數量

各位前輩好
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 時間: 2020-8-7 22:00

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

複製代碼

作者: Andy2483 時間: 2020-8-7 22:29

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

作者: Andy2483 時間: 2020-8-10 07:58

本帖最後由 Andy2483 於 2020-8-10 07:59 編輯

回復 2# ikboy

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

作者: n7822123 時間: 2020-8-10 22:17

本帖最後由 n7822123 於 2020-8-10 22:26 編輯

回復 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

修改你的範例檔如下

[attach]32386[/attach]

作者: n7822123 時間: 2020-8-10 22:41

回復 4# Andy2483

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

ikboy 是用註解找儲存格

作者: Andy2483 時間: 2020-8-11 10:07

回復 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 時間: 2020-8-11 11:03

回復 7# Andy2483

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

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

Option Explicit
'365 之前版本只有 Comment 物件為[註解]
'365 版本中 Comment 物件為[附註]
'365 版本中新增CommentThreaded 物件為[註解]
Sub Ex註解()
Dim Msg As String
With ActiveSheet
If .Comments.Count > 0 Then Msg = "[附註] 有" & .Comments.Count & "個 " & 註解副程式(.Comments)
If Application.Version >= 16 Then '版本365以上
If Msg <> "" Then Msg = Msg & vbLf & vbLf
If .CommentsThreaded.Count >= 0 Then Msg = Msg & "[註解] 有" & .CommentsThreaded.Count & "個 " & 註解副程式(.CommentsThreaded)
End If
If Msg = "" Then Msg = .Name & " 沒有任何註解...."
MsgBox Msg
End With
End Sub
Function 註解副程式(comm As Object) As String
Dim e As Object, 註解 As String
For Each e In comm
If TypeName(e) = "CommentThreaded" Then '版本365以上
註解 = 註解 & IIf(註解 <> "", vbLf, "") & e.Parent.Cells.Address & " " & e.Text
Else ' 版本365以下
註解 = 註解 & IIf(註解 <> "", vbLf, "") & e.Shape.TopLeftCell.Address & " " & e.Text
End If
Next
註解副程式 = vbLf & 註解
End Function

複製代碼

作者: ikboy 時間: 2020-8-11 12:33

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

Debug.print Activesheet.comments.count

複製代碼

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

作者: Andy2483 時間: 2020-8-11 14:42

回復 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可測試....)

作者: Andy2483 時間: 2020-8-11 14:50

回復 9# ikboy

謝謝前輩指導
Andy愚鈍需要再花點時間研習您的指導

作者: Andy2483 時間: 2020-8-11 15:46

回復 9# ikboy

謝謝各位前輩指導
1.Andy沒有矯情!要承認今天才懂Debug.Print: 在即時運算窗顯示結果
1.1.對ikboy前輩很抱歉!在4樓提到測試結果跟想要的結果不一樣是因為不會用 Debug.Print
1.2.還被一長串的程式碼嚇到,當下以為是前輩會錯意
1.3.衍伸後來各位前輩的再指導
2.謝謝各位前輩耐心指導

作者: Andy2483 時間: 2020-8-11 22:20

回復 6# n7822123

前輩的指導很客氣謝謝
1.檢討了自己的觀念問題
1.1.直接找註解就可以了，何必一格格的找？
1.2.必竟整表註解的數量定比儲存格樹量少
1.3.要找註解數量或註解位置跑掉的數量！就整表都找就好了，何必局限在某區域
2.謝謝前輩指導

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)