Question

我有Sheet1和Sheet2。

Sheet 1中：
-A1具有“名称”（按字母顺序排序）
-B1有“标题”
-C1有“代码”
*大约有200行数据

Sheet 2中：
- 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

我正在努力解决如何将这些评论放在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代码，你将会遇到很多未来的问题：）

请参阅此内容，了解为什么通常首选避免依赖Select或Activate与VBA。

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

Answer 2

此解决方案假设如下：

人员列表位于Sht(1) 的工作表A1:C5中（参见图1）
组织结构图位于工作表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

VBA for Excel评论

2 个答案: