[[20111129173053]]　『マクロを実行し、条件に一致した別sheetのセルにメx（ねこ）　ページの最後に飛ぶ

『マクロを実行し、条件に一致した別sheetのセルにジャンプしたい』（ねこ）

 お世話になります、どうしてもわからなかったので質問させてください。
 Excel2007です

 ・sheet1のA1には数字を入力できるようにしてあります
 ・sheet1のA3あたりにフォームコントロールのボタンを置きます
 ・sheet2以降に会員番号とその他データを登録してあります。
 （例：sheet2のA1に会員番号　その下に会員情報。sheet2のA10に別の会員番号・・・
 20人分超えると、sheet3、sheet4と増える）

 ・sheet1のA1に数字を入力します（例：会員番号）
 ・ボタンをクリックすると、その会員番号と同じ番号のsheetのセルにジャンプ

 以上のことを実行したいのですが、ご教授いただけますでしょうか？

 Sheet2以降の構成というかレイアウトが、なんとなく扱いにくいような気もするけど、それは、当方がどうこういうことじゃないので。

 たとえば会員番号が、必ず１から始まる連番なんかであれば、Sheet1のA1の値から、それが存在するシートをわりだして
そこを表示するなんてこともできるけそ、そうじゃないんだろうから。

 で、たとえばSHeet2のA2～A9が会員情報なんだろうけど、そのなかに「たまたま」会員番号と同じものがあるのか、ないのかにもよるんだけど。
・ないばあい　Sheet2以降のA列を片っ端からMatchあたりで検索して存在すればそこ。どのシートにもなければエラー。
・会員番号と同じものがある場合は、Matchは使えないので（きわめて使いにくいので）Stepを9にしたFor/Nextかな。

 追記）Sheet2以降だけど、最初はA1、次がA10。その次は？　9行ずつならA19だけど、そうなの？A20なんてことはないんだろうね。

 (ぶらっと)

 うえでいった２つのケースそれぞれの処理案。（ただし、２つめのケース、A10の次はA19)

 Sub Sample1()
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim flag As Boolean
    Dim d As Variant

    Set sh1 = Sheets("Sheet1")
    d = sh1.Range("A1").Value
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        For Each sh In Worksheets
            If Not sh Is sh1 Then
                If IsNumeric(Application.Match(d, sh.Columns("A"), 0)) Then
                    flag = True
                    Exit For
                End If
            End If
        Next
        If flag Then
            sh.Select
        Else
            MsgBox "会員番号" & d & "が見あたりません"
        End If
    End If

    Set sh1 = Nothing

 End Sub

 Sub Sample2()
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim flag As Boolean
    Dim d As Variant
    Dim i As Long

    Set sh1 = Sheets("Sheet1")
    d = sh1.Range("A1").Value
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        For Each sh In Worksheets
            If Not sh Is sh1 Then
                For i = 1 To sh.Range("A" & sh.Rows.Count).End(xlUp).Row Step 9
                    If sh.Cells(i, 1).Value = d Then
                        flag = True
                        Exit For
                    End If
                Next
                If flag Then Exit For
            End If
        Next
        If flag Then
            sh.Select
        Else
            MsgBox "会員番号" & d & "が見あたりません"
        End If
    End If

    Set sh1 = Nothing

 End Sub

 (ぶらっと)

 ご教授、ありがとうございます。
 いずれの場合でも実行できることを確認しました！
 会員情報の中には会員番号と一致するものはないので、1つ目のほうを使わせていただきます
 （別の人が作成した会員情報をそのまま利用しようとしており、会員番号が9行ごとに固定されているか怪しいところもありますので・・・）。

 ちなみに、一致した会員番号のあるsheetを開くだけでなく、一致するセルにまでジャンプするということは制限としてできないんでしょうか？

 質問ばかりで申し訳ありません。

 (ねこ)

 じゃぁSample1をベースに

 Sub Sample3()
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim flag As Boolean
    Dim d As Variant
    Dim n As Variant

    Set sh1 = Sheets("Sheet1")
    d = sh1.Range("A1").Value
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        For Each sh In Worksheets
            If Not sh Is sh1 Then
                n = Application.Match(d, sh.Columns("A"), 0)
                If IsNumeric(n) Then
                    flag = True
                    Exit For
                End If
            End If
        Next
        If flag Then
            Application.Goto sh.Cells(n, "A"), True
        Else
            MsgBox "会員番号" & d & "が見あたりません"
        End If
    End If

    Set sh1 = Nothing

 End Sub

 (ぶらっと)

 ぶらっとさま、ありがとうございます！
 思っていた通りの処理ができるようになりました。

 （ねこ）

 横から失礼します。

 sheet2の複数列（例えばA列とF列とK列）にここでいう会員番号が登録してある場合には
 実現不可能でしょうか

 似たような質問があり喜んだのですが検索範囲が１列でないため困っています（はいちゅう）

 別トピをたてたほうがいいかと思うけど。

 Sub Sample4()
    Dim sh As Worksheet
    Dim sh1 As Worksheet
    Dim flag As Boolean
    Dim d As Variant
    Dim n As Variant
    Dim col As Variant

    Set sh1 = Sheets("Sheet1")
    d = sh1.Range("A1").Value
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        For Each sh In Worksheets
            If Not sh Is sh1 Then
                For Each col In Array("A", "F", "K")
                    n = Application.Match(d, sh.Columns(col), 0)
                    If IsNumeric(n) Then
                        flag = True
                        Exit For
                    End If
                Next
                If flag Then Exit For
            End If
        Next
        If flag Then
            Application.Goto sh.Cells(n, col), True
        Else
            MsgBox "会員番号" & d & "が見あたりません"
        End If
    End If

    Set sh1 = Nothing

 End Sub

 (ぶらっと)

 質問ばかりですみません…

 会員情報の入ったExcelと検索をかけるExcelを別にするよう指示されました。
 別ブックの参照＆ジャンプは出来るのでしょうか？
 またこの場合、別ブック（会員情報の入ったブック）は常に開いておく必要はありますか？

 （ねこ）

 >会員情報の入ったExcelと検索をかけるExcelを別にするよう指示されました。

 これは、適切かつ、正しい指示だね。

 >別ブックの参照＆ジャンプは出来るのでしょうか？

 参照は、もちろんできるし、ジャンプも
Application.Goto ブックオブジェクト.シートオブジェクト.セルオブジェクト, True　というコードでＯＫだよ。

 >別ブック（会員情報の入ったブック）は常に開いておく必要はありますか？

 「常に」というのが、ちょっとあいまいだけど、少なくとも検索を実行してジャンプする時には開いておかなきゃね。

 (ぶらっっと)

 ありがとうございます。できるのですね！
 別ブックの参照の指示の仕方がわからないので、教えていただけると幸いです。
 （初心者で申し訳ありません・・・）

 ちなみに、別ブックを参照するときには、そのブックは同じディレクトリ内にある、
 あるいはいつも同じ場所に保管されている状態でないと指定できないですよね？

 というのも、CDかUSBキーに保管し、複数の人間が別拠点で触れることが目的です
 （ネットワークでの共有は今のところできない予定です）。

 それでは以下。Sample3をベースに変更ポイントがわかりやすいように、削除したコードもコメントとして残してある。
会員番号指定はマクロブック側のSheet1のA1に入力して実行。
かつ、マクロ実行時には当該データブックが「別途」呼び出されているという前提。
もし、マクロで、必要なものを呼び出す部分も実行させたいなら、それはそれで可能。

 >別ブックを参照するときには、そのブックは同じディレクトリ内にある、
 >あるいはいつも同じ場所に保管されている状態でないと指定できないですよね？

 マクロブックと同じフォルダにあればコードがシンプル。でも、別フォルダにあってもきまったフォルダなら
 これも、どうってことない。
 フォルダが可変（場合によってはデータブックも可変）ということなら、ファイルを選択するダイアログを表示して
 そこで操作者に選ばせることも可能。

 Sub Sample3A()
    Dim wb As Workbook     '★追加
    Dim sh As Worksheet
    'Dim sh1 As Worksheet　'★削除
    Dim flag As Boolean
    Dim d As Variant
    Dim n As Variant

    Set wb = Workbooks("別ブック.xls")   '★追加
    'Set sh1 = Sheets("Sheet1")          '★削除
    d = ThisWorkbook.Sheets("Sheet1").Range("A1").Value      '★変更
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        For Each sh In wb.Worksheets     '★変更
            'If Not sh Is sh1 Then       '★削除
                n = Application.Match(d, sh.Columns("A"), 0)
                If IsNumeric(n) Then
                    flag = True
                    Exit For
                End If
            'End If                      '★削除
        Next
        If flag Then
            Application.Goto sh.Cells(n, "A"), True
        Else
            MsgBox "会員番号" & d & "が見あたりません"
        End If
    End If

    Set wb = Nothing      '★追加
    'Set sh1 = Nothing    '★削除

 End Sub

 (ぶらっと)

 Sample3Aをベースに別ブックをマクロから開くコードを２つ。
Sample3B 当該データブックを直接開いて処理。
Sample3C ダイアログからデータブックを指定して開いて処理。

 Sub Sample3B()
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim flag As Boolean
    Dim d As Variant
    Dim n As Variant

    Set wb = Workbooks.Open("c:\フォルダ名\サブフォルダ名\別ブック.xlsx")
    'マクロブックと同じフォルダなら
    'Set wb = Workbooks.Open(ThisWorkbook.Path & "\別ブック.xlsx")

    d = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        For Each sh In wb.Worksheets
                n = Application.Match(d, sh.Columns("A"), 0)
                If IsNumeric(n) Then
                    flag = True
                    Exit For
                End If
        Next
        If flag Then
            Application.Goto sh.Cells(n, "A"), True
        Else
            MsgBox "会員番号" & d & "が見あたりません"
        End If
    End If

    Set wb = Nothing

 End Sub

 Sub Sample3C()
    Dim wb As Workbook
    Dim sh As Worksheet
    Dim flag As Boolean
    Dim d As Variant
    Dim n As Variant
    Dim fName As String

    d = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
    If Len(d) = 0 Then
        MsgBox "会員番号が指定されていません"
    Else
        fName = Application.GetOpenFilename("会員情報ブック,*.xlsx", , "会員情報ブックを選んでください")
        If fName <> "Flase" Then
            Set wb = Workbooks.Open(fName)

            For Each sh In wb.Worksheets
                    n = Application.Match(d, sh.Columns("A"), 0)
                    If IsNumeric(n) Then
                        flag = True
                        Exit For
                    End If
            Next
            If flag Then
                Application.Goto sh.Cells(n, "A"), True
            Else
                MsgBox "会員番号" & d & "が見あたりません"
            End If
        End If
    End If

    Set wb = Nothing

 End Sub

 (ぶらっと)

 ぶらっとさま　ありがとうございます。
 Sample3Bを使わせていただき、うまくいきました！

 マクロブックと会員情報のブックは、常に同じフォルダ内には保存するので、
 Set wb = Workbooks.Open(ThisWorkbook.Path & "\別ブック.xlsx")で
 うまく実現できそうです。

 本当にありがとうございました。

コメント返信：

[ 一覧(最新更新順) ]

[[20111129173053]] 『マクロを実行し、条件に一致した別sheetのセルにメx（ねこ） ページの最後に飛ぶ

[[20111129173053]]　『マクロを実行し、条件に一致した別sheetのセルにメx（ねこ）　ページの最後に飛ぶ