0

マクロは初めてで、少しの洞察を探しています。

選択したボックスの値に基づいて、セルにテーブルの情報を別のシートに表示させたいと考えています。

Movies というテーブルから取得した評価に基づいて、映画のタイトルを返す 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 テーブルに同じ名前の映画が複数あるため、タイトルと年の両方を一致させる必要があります。

これまでにテスト用に作成したマクロを次に示します (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 が選択された場合、ムービー テーブルで Eternal Sunshine of the Spotless Mind が検索され、そのプロットが 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 に答える