通过宏复制excel中的值

Question

宏是新的，我正在寻找一点洞察力。

我正在寻找一个基于所选框中的值的单独显示表格中的单元格信息。

我有5个单元格根据它的评级从名为“电影”的表中拉出一个标题给电影。我还在它旁边有5个单元格，返回一年，然后是5个单元格，并与评分相邻。这里是什么样子：

     A      B  C 
    ______________________________________________________ 
1 | Eternal Sunshine of the Spotless Mind | 2004 | 8.5 | 
2 | 3 Idiots        | 2009 | 8.2 | 
3 | Before Sunrise       | 1995 | 8.1 | 
4 | Groundhog Day       | 1993 | 8.1 | 
5 | (500) Days of Summer     | 2009 | 8.0 | 

我想要让这个被选中A1单元格时，该地块从电影表中的电影工作拉。

Worksheet = movies 
Table = Movies 
Column = Plot 

我需要能够匹配标题和年份，因为我的Movies表中有多个具有相同名称的电影。

这里是我到目前为止创建与测试宏（结果1是A1的名字，结果2是A2的名称等）：

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
    If Not Intersect(Target, Range("Result1")) Is Nothing Then 
     MsgBox Target.Address & " is Result1." 
    ElseIf Not Intersect(Target, Range("Result2")) Is Nothing Then 
     MsgBox Target.Address & " is Result2." 
    ElseIf Not Intersect(Target, Range("Result3")) Is Nothing Then 
     MsgBox Target.Address & " is Result3." 
    ElseIf Not Intersect(Target, Range("Result4")) Is Nothing Then 
     MsgBox Target.Address & " is Result4." 
    ElseIf Not Intersect(Target, Range("Result5")) Is Nothing Then 
     MsgBox Target.Address & " is Result5." 
    Else 
    End If 
End Sub 

我想复制的情节将所选单元格中的电影放入单元格B7中。

例如，如果选择了Result1，它将在电影表中找到无光泽心灵的永恒阳光，并在B7中输出它的情节。

感谢您的帮助！

编辑：这是电影表的样子：

ID Title       Year Duration Rating Plot 
    _____________________________________________________________________________________________________________________________________________________________________________________ 
    | 1 | (500) Days of Summer   | 2009 | 95 min | 8.0 | An offbeat romantic comedy about a woman who doesnt believe true love exists, and the young man who falls for her. | 

Answer 1

我可能会使用自动筛选。根据您参考的电影表结构（我没有这个结构），您需要修改自动筛选器Field的值，并确保您定义了tblRange。

每OP修订评论&示例文件结构

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
Dim movieTitle As String 
Dim movieYear As String 

If Not Intersect(Target, Range("Result1")) Is Nothing Then 
    movieTitle = Range("Result1").Value 'Modified because you use merged cells... 
    movieYear = Range("Result1").Offset(0, 1).Value 'modified. 
    GetMovieInfo movieTitle, movieYear 
End If 
If Not Intersect(Target, Range("Result2")) Is Nothing Then 
    movieTitle = Range("Result2").Value 'Modified because you use merged cells... 
    movieYear = Range("Result2").Offset(0, 1).Value 'modified. 
    GetMovieInfo movieTitle, movieYear 
End If 
If Not Intersect(Target, Range("Result3")) Is Nothing Then 
    movieTitle = Range("Result3").Value 'Modified because you use merged cells... 
    movieYear = Range("Result3").Offset(0, 1).Value 'modified. 
    GetMovieInfo movieTitle, movieYear 
End If 
If Not Intersect(Target, Range("Result4")) Is Nothing Then 
    movieTitle = Range("Result4").Value 'Modified because you use merged cells... 
    movieYear = Range("Result4").Offset(0, 1).Value 'modified. 
    GetMovieInfo movieTitle, movieYear 
End If 
If Not Intersect(Target, Range("Result5")) Is Nothing Then 
    movieTitle = Range("Result5").Value 'Modified because you use merged cells... 
    movieYear = Range("Result5").Offset(0, 1).Value 'modified. 
    GetMovieInfo movieTitle, movieYear 
End If 

End Sub 

子程序，GetMovieInfo将过滤电影台，并在消息框中返回从第6列（图）结果为您服务。

Sub GetMovieInfo(movieTitle As String, movieYear As String) 
Dim tblRange As Range 
Set tblRange = Sheets("movies").Range("Movies") 
With tblRange 
.AutoFilter Field:=2, Criteria1:=movieTitle '<change to filter column "2" 
.AutoFilter Field:=3, Criteria1:=movieYear 'change to filter to column "3" 
    With .SpecialCells(xlCellTypeVisible) 
     If .Areas.Count > 1 Then 
      MsgBox .Areas(2).Cells(1, 10).Value 
     Else: 
      MsgBox .Areas(1).Cells(1, 10).Value 
     End If 
    End With 
.AutoFilter 
End With 
End Sub 

Answer 2

我建议使用Find Range属性。该功能可如下：

Function GiveMeMoviePlot(MovieRange As Range, MovieTitle As String, _ 
      MovieYear As String) 
    'pass movieTable to MovieRange 

Dim A As Range 
Dim checkAddress As String 

Set A = MovieRange.Find(MovieTitle, , xlValues, xlWhole, , xlNext, False) 
checkAddress = A.Address 

If Not A Is Nothing Then 

    Do 
     Debug.Print A.Address 
     If A.Offset(0, 1) = MovieYear Then 
      'found 
      GiveMeMoviePlot = A.Offset(0, 4) 
      Exit Function 
     Else 
      Set A = MovieRange.FindNext(A) 

     End If 

    Loop While A.Address <> checkAddress 

End If 

     GiveMeMoviePlot = "Nothing found" 
End Function 

逻辑的其余部分是相当类似的@DavidZemens