0

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

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

我有 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，它会在movie表中找到一尘不染的永恒阳光，并在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. |
4

2 回答 2

1

我可能会使用自动过滤器。根据您引用的电影表的结构（我没有可用的），您需要修改 AutoFilterField值，并确保定义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
于 2013-03-27T19:42:46.500 回答
0

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

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 的逻辑非常相似

于 2013-03-27T20:21:39.867 回答