☰

如何根据单元格值将单元格值转移或复制到不同工作表中的另一个单元格？

tag-icon • tag-icon microsoft-excel vba
如何根据单元格值将单元格值转移或复制到不同工作表中的另一个单元格？

我有两个工作表，一个叫做数据库，另一个叫做项目卡。

每个项目的所有信息都在数据库表的一行中，由特定的项目编号标识。项目卡表包含用户指定的单个项目的所有信息。用户输入项目编号，然后使用 Vlookup 显示与该项目相关的信息。

我的问题是，用户有时需要在项目卡表上为特定项目添加注释，并且我希望该注释也列在数据库表上。

例如：用户在项目卡表上输入 304（项目编号），在阅读详细信息后，用户添加有关项目 304 的注释。我希望将该注释转移到数据库表中项目编号 304 的行中。

答案1

由于在项目卡表上输入的注释只是临时的，因此您必须使用 VBA 来执行此操作。这有点棘手，因为您希望即使项目卡上的注释消失后仍将注释保留在数据库表上。

为此，您需要在项目卡表上添加一个由 VLOOKUP() 填充的“注释”列，以及另一列（可能是“新注释”），用户可以在其中输入或更改现有注释。

以下是一些示例代码，可帮助您入门。它只有几行代码，我还添加了注释，以帮助您根据自己的情况进行调整。

该子程序监视项目卡表上新注释列的任何更改，并将更改的单元格复制到数据库表上正确的项目编号行。

Private Sub Worksheet_Change(ByVal Target As Range)

    'Setup variables
    'KeyCells contains the cells that will trigger the action when changed.
    Dim KeyCells As Range
    Dim ProjectNum As Integer
    Dim DBProjectCell As Range

    Set KeyCells = Range("E2:E8")   'Change "E2:E8" to your Project Card column where user enters a New Note.
    ProjectNum = Range("A2").Value  'Change "A2" to your Project Card cell containing the Project Number.

    'Check to see if anything changed in the New Note column
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then   
        'Don't delete an existing Note when the Target goes blank
        If Target.Value <> "" Then
           'Get the Database worksheet cell containing this project number
           'Change "A11:A21 to the Database column containing the project numbers
           Set DBProjectCell = Worksheets("Database").Range("A11:A21").Find(What:=ProjectNum)

           'Copy the new Note to the Database sheet.
           'Change "J" to the Database column where the Notes will go:
           Worksheets("Database").Range("J" & DBProjectCell.Row).Value = Target.Value
        End If
    End If

End Sub

希望这能有所帮助。如果您是 VBA 新手，请按照此帮助页面上的说明进行操作将 Excel VBA 代码复制到：工作表模块。

相关内容