エクセルについて質問です。


基データのシートがあるのですが、データの量が膨大なのでデータの閲覧がしやすいように別のシートに条件があうものだけを閲覧できるようにしたいと考えています。

行いたいことのイメージは以下のURLです。

http://oskuni7.sakura.ne.jp/hatena/question14/question14.htm

上記のように条件にあったデータを基データを基に簡単に閲覧できるようにしたいです。

そして今回は、閲覧だけではなく、もしシート2で あ のデータ1のデータ を変えると、基データの あ データ1も同じようにデータが切り替わることをしたいと考えています。

このような設定をエクセルに持たせる事はVBAで可能でしょうか?

回答の条件
  • 1人2回まで
  • 登録:2009/01/21 16:22:51
  • 終了:2009/01/22 11:07:50

ベストアンサー

id:SALINGER No.1

SALINGER回答回数3454ベストアンサー獲得回数9692009/01/21 19:26:18

ポイント100pt

1行目は判別とデータのタイトルが入っているとして、実際のデータは2行目からになるでしょうか。

実行する前にSheet1以外のシートを削除してください。

Sub Macro1()
    Dim lastRow As Long
    Dim i As Long
    Dim sh As Worksheet
    Dim f As Boolean
    Dim r As Range
    Dim lastRow2 As Long
    Dim SheetCount As Integer
    
    SheetCount = 2

    With Sheet1
    lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
    For i = 2 To lastRow
        f = False
        For Each sh In Worksheets
            If sh.Name <> "Sheet1" Then
                If sh.Range("A2").Value = .Cells(i, 1).Value Then
                    Set r = sh.Range("B:B").Find(.Cells(i, 2).Value)
                    If r Is Nothing Then
                        lastRow2 = sh.Cells(Rows.Count, 1).End(xlUp).Row
                        sh.Cells(lastRow2 + 1, 1).Value = .Cells(i, 1).Value
                        sh.Cells(lastRow2 + 1, 2).Value = .Cells(i, 2).Value
                        .Cells(i, 1).Formula = "=" & sh.Name & "!A" & lastRow2 + 1
                        .Cells(i, 2).Formula = "=" & sh.Name & "!B" & lastRow2 + 1
                    End If
                    f = True
                    Exit For
                End If
            End If
        Next
             
        If Not f Then
            Worksheets.Add
            ActiveSheet.Name = "Sheet" & SheetCount
            ActiveSheet.Range("A1").Value = .Range("A1").Value
            ActiveSheet.Range("B1").Value = .Range("B1").Value
            ActiveSheet.Range("A2").Value = .Cells(i, 1).Value
            ActiveSheet.Range("B2").Value = .Cells(i, 2).Value
            .Cells(i, 1).Formula = "=Sheet" & SheetCount & "!A2"
            .Cells(i, 2).Formula = "=Sheet" & SheetCount & "!B2"
            SheetCount = SheetCount + 1
        End If
    Next i
    End With
End Sub
id:aiomock

ご回答ありがとうございます。

プログラム実行されました。

このような機能をエクセルに持たせることができるのですね。

とても参考になりました。

2009/01/22 11:07:38
  • id:aiomock
    最後にお聞きしたいのですが

    条件判定を変えた場合、条件が違う場所へデータと条件判定をシート移動させることも可能でしょうか?

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません