Excel的VBA註釋

Question

我有Sheet1和Sheet2。

工作表Sheet1：
-A1有 「名」（按字母順序排序）
-B1有 「標題」
-C1有 「典」
*大概有200行數據

Sheet2中的：從Sheet1名
- 每個都在Sheet2中，但它們都是基於報告結構安排，並在多個列

我有什麼：

Sub TitleAndCode() 
Dim sh1 As Worksheet 
Dim sh2 As Worksheet 

Set sh1 = ActiveWorkbook.Sheets("Sheet1") 
Set sh2 = ActiveWorkbook.Sheets("Sheet2") 

For i = 2 To 7 
    With sh2.Range("A" & i) 
    .ClearComments 
    .AddComment 
    .Comment.Text Text:=sh1.Range("B" & i).Value & _ 
         Chr(10) & sh1.Range("C" & i).Value 
End With 
Next 
End Sub 

目前，這隻適用於7行。在Sheet1中，我有200多行，如果人員配置發生變化，需要添加更多。

此代碼將評論置於A2：A7中。我正在創建一個宏，用於在Sheet2中的列B到M中搜索名稱，並向包含名稱的每個單元格添加註釋。我希望評論能夠從Sheet1中顯示該名稱的標題和代碼。 Example of Sheet2

Answer 1

該解決方案假定：人員

• 列表位於表Sht(1)在A1:C5（見圖。 1）
• Org anization Chart在表Sht(2)（見圖。2）

（根據需要調整工作表名稱和範圍）

一些在此過程中使用的資源可能是新的用戶，因此它建議您仔細閱讀以下頁面：

Variables & Constants，Excel Objects，With Statement，Range Properties (Excel)

試試這個代碼（參見內它評論）：

Option Explicit 
Option Base 1 ‘Used at module level to declare the default lower bound for array subscripts. 

Sub OrgChr_Update() 
Rem Always declare all variables 
Dim Wsh1 As Worksheet, Wsh2 As Worksheet 
Dim aNames As Variant 
Dim rCllFnd As Range 
Dim l As Long 
Dim lLstRow As Long 
Dim sFnd1st As String 

    Rem Set Worksheets 
    With ThisWorkbook ‘Assumes procedure resides in same workbook, thus the use of ThisWorkbook instead of ActiveWorkbook 
     Set Wsh1 = .Sheets("Sht(1)") 
     Set Wsh2 = .Sheets("Sht(2)") 
    End With 

    Rem Get List of Names 
    With Wsh1.Columns(1) 
     ‘Used to find last row with values, then to define the range with the Names, Titles & Codes 
     lLstRow = .Find(What:="*", _ 
      After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlPart, _ 
      SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _ 
      MatchCase:=False, SearchFormat:=False).Row 
     aNames = Range(.Cells(2), .Cells(lLstRow)).Resize(, 3).Value2 ‘Set List with Names, Titles & Codes as Array 
    End With 

    Rem Search for Names in Wsh2 
    With Wsh2.UsedRange 

     Rem To Delete All Comments 
     .Cells.ClearComments  'Use this line if only comments related to Org. Chart Names exist in Wsh2 

     For l = 1 To UBound(aNames) 
      Rem Search for Whole matches (adjust to xlPart if required) 
      Set rCllFnd = .Find(What:=aNames(l, 1), _ 
       After:=.Cells(1), LookIn:=xlFormulas, LookAt:=xlWhole, _ 
       SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _ 
       MatchCase:=False, SearchFormat:=False) 

      Rem Validate Search Results 
      If Not (rCllFnd Is Nothing) Then 

       Rem Set address of first match found use later to validate completeness 
       sFnd1st = rCllFnd.Address 

       Rem Run action with cell found & reiterate search 
       Do 

        Rem Update Cell Comment as New 
        With rCllFnd 
         Rem Add Comment 
         Rem .ClearComments 'Use this line if there will be other comments not related to Org. Chart Names in Wsh2 
         .AddComment 
         .Comment.Visible = True 
         .Comment.Text Text:=aNames(l, 2) & vbLf & aNames(l, 3) 
        End With 

        Rem Find next match 
        Set rCllFnd = .FindNext(After:=rCllFnd) 

       Rem Validate Search completness 
       Loop While rCllFnd.Address <> sFnd1st 

    End If: Next: End With 

End Sub 

圖1

圖2

Answer 2

我很擔心如何將這些註釋放在Sheet2中的相應單元格上。

這是你擁有的一切：

Sheets("Sheet1").Select 

For i = 2 To 7 

    Range("A" & i).ClearComments 

即相當於：

For i = 2 To 7 

    Sheets("Sheet1").Range("A" & i).ClearComments 

如果您使用Select或Activate，你應該總是符合你的範圍對象，否則，一個不合格的範圍對象總是指運行時的任何工作表活動。

您將需要爲您的Range對象的全部這樣做。雖然這是容易現在做傻事，並簡單地做Sheets("Sheet2").Select，如果你繼續這樣做VBA代碼這樣，你會在運行了很多在未來:)

問題，請參閱本學習關於爲什麼通常優選避免使用帶有VBA的Select或Activate。

How to avoid using Select in Excel VBA macros

我會做這樣的事情：

Sub TitleAndCode() 
'Takes values from Sheet1 and puts them in comments on Sheet2 
Dim sh1 As Worksheet 
Dim sh2 As Worksheet 

Set sh1 = ActiveWorkbook.Sheets("Sheet1") 
Set sh2 = ActiveWorkbook.Sheets("Sheet2") 

For i = 2 To 7 
    With sh2.Range("A" & i) 
     .ClearComments 
     .AddComment 
     .Comment.Text Text:=sh1.Range("B" & i).Value & _ 
          Chr(10) & sh1.Range("C" & i).Value 
    End With 
Next 

End Sub