Question

宏的新手，我正在寻找一点见解。

我希望根据所选框中的值，从单独的工作表中的表中获取单元格显示信息。

我有5个单元格，根据它从名为Movies的表中提取的等级返回电影的标题。我旁边还有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

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

这是我到目前为止测试的宏（Result1是A1的名称，Result2是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

我可能会使用AutoFilter。根据您引用的电影表格结构（我没有掌握），您需要修改自动筛选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将过滤Movies表并从消息框中的第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

通过宏复制excel中的值

2 个答案: