お酒好きのおしりトラブル対策とは

シート1
1|品名 種類 名前 データ
2|A 1 あ 21
3|B 2 い 11
4|F 2 あ 51
5|A 1 い 21 
6|B 2 あ 64
7|A 1 あ 84


シート2
1|品名 A
2|種類 1
3|
4|名前
5|あ
6|い


シート1のデータから、シート2の2つの条件(A1:B2)で、重複しない名前を表示する方法を教えて下さい。
上記のデータでいうと、品名Aであり種類が1の名前を重複なしで特定の位置(A5)から詰めて縦に表示するようにして、
シート1のデータ、シート2の条件を変更したらA5からの名前が自動更新されるようにしたいです。

以下できたら追加したいこと
1.表示する名前の順番が、シート2の条件で集計したデータ値が多い名前順
2.シート2のB2の種類に0を入れると種類の条件無しで表示


実際はA5からの名前の行は数行を結合したもので右側には複数の行でデータ項目別になって、名前が入力された時に日毎のデータを自動表示しています。
全部で名前の種類は30以上ありますが、品名の条件をつければ名前は10種類以下になります。
グラフは名前別で表示しており、不要な名前が増えると表示しずらいので、必要な名前だけのデータを表示するようにしたいです。

どうかよろしくお願いします。

このQ&Aに関連する最新のQ&A

A 回答 (3件)

No.1です!


補足を読ませていただきました。
データは10000行位あり、今後も増える予定だというコトですので、
VBAでの方法はどうでしょうか?

※ 実は前回、
>1.表示する名前の順番が、シート2の条件で集計したデータ値が多い名前順
>2.シート2のB2の種類に0を入れると種類の条件無しで表示
の件を無視していましたので、

Sheet1・Sheet2の配置はお示し通りになっていて、Sheet3を作業用に使用しています。
(Sheet3は現在なにも使用していないという前提です。)

画面左下にあるSheet2のSheet見出し上で右クリック → コードの表示 → VBE画面が出ますので
↓のコードをコピー&ペーストしてSheet2のB1・B2セルのデータを変更してみてください。


Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i, j As Long
Dim ws1, ws3 As Worksheet
Set ws1 = Worksheets(1)
Set ws3 = Worksheets(3)
Application.ScreenUpdating = False
If Target.Row <= 2 And Target.Column = 2 Then
If WorksheetFunction.CountBlank(Range("B1:B2")) Then Exit Sub
i = Cells(Rows.Count, 1).End(xlUp).Row
If i > 4 Then
Range(Cells(5, 1), Cells(i, 1)).ClearContents
End If
ws1.Columns("A:D").Copy Destination:=ws3.Cells(1, 1)
ws3.Columns("A:D").Sort key1:=ws3.Cells(1, 4), order1:=xlDescending
ws3.Columns(1).Insert
If Cells(2, 2) = 0 Then
For i = 2 To ws3.Cells(Rows.Count, 2).End(xlUp).Row
If ws3.Cells(i, 2) = Cells(1, 2) And _
WorksheetFunction.CountIf(ws3.Columns(1), ws3.Cells(i, 4)) = 0 Then
ws3.Cells(i, 1) = ws3.Cells(i, 4)
End If
Next i
For j = 2 To ws3.Cells(Rows.Count, 1).End(xlUp).Row
If ws3.Cells(j, 1) <> "" Then
Cells(Rows.Count, 1).End(xlUp).Offset(1) = ws3.Cells(j, 1)
End If
Next j
Else
For i = 2 To ws3.Cells(Rows.Count, 3).End(xlUp).Row
If ws3.Cells(i, 2) = Cells(1, 2) And ws3.Cells(i, 3) = Cells(2, 2) And _
WorksheetFunction.CountIf(ws3.Columns(1), ws3.Cells(i, 4)) = 0 Then
ws3.Cells(i, 1) = ws3.Cells(i, 4)
End If
Next i
For j = 2 To ws3.Cells(Rows.Count, 1).End(xlUp).Row
If ws3.Cells(j, 1) <> "" Then
Cells(Rows.Count, 1).End(xlUp).Offset(1) = ws3.Cells(j, 1)
End If
Next j
End If
ws3.Cells.ClearContents
Application.ScreenUpdating = True
End If
End Sub 'この行まで

※ B2セルが「0」の場合は「種類」は無視して、「品名」ごとの最大データの人を表示!
※ B2セルが「0」以外の場合は「品名」・「種類」が一致する最大データの人を表示!
という考え方にしています。

お役に立てば良いのですが・・・m(_ _)m
    • good
    • 0
この回答へのお礼

ご回答有難うございます。
わざわざプログラムを書いて頂きありがたいです。
実際の形式にするのにすぐには無理そうなので、あとでとっておきます。
とりあえず教えて頂いた追加列で種類判定もつけてうまくいっております。
有難うございました。

お礼日時:2011/10/03 18:38

補助列なしに関数で重複のない名前データを表示するなら(最大10件まで)、以下のような複雑な数式を使う必要があります。


ただし配列数式ですので入力後Ctrl+Shift+Enterで確定してください。

=INDEX(Sheet1!C:C,SMALL(IF((MATCH(Sheet1!$A$2:$A$10000&Sheet1!$B$2:$B$10000&Sheet1!$C$2:$C$10000,Sheet1!$A$2:$A$10000&Sheet1!$B$2:$B$10000&Sheet1!$C$2:$C$10000,)=ROW($A$2:$A$10000)-1)*($B$1&$B$2=Sheet1!$A$2:$A$10000&Sheet1!$B$2:$B$10000),ROW($A$2:$A$10),10000),ROW(A1)))&""

一般的に、上記のような配列数式はデータ範囲を大きくしたり、数式で表示するセルが多くなると再計算に時間がかかりシートの動きが重くなるなどのデメリットがあります。
今回のような表示件数が10件までで良いなら、おそらくそれほど大きな影響はないかもしれませんが、シートの動きが重く感じたら、シートの計算方法を「手動」に設定しておき、必要に応じてF9キーで再計算するような対応をしてください。

一方、1万行もあるデータに対して、補助列の多数のセルにCOUNTIF関数やMATCH関数など比較的メモリーを多く消費する関数を入力すると、パソコンがハングアップすることがありますので、今回のようなケースでは補助列を使う方法はあまりお勧めできません。

しかし、一般的に配列数式を駆使して表示する場合は、数式そのものの意味がわかりにくく、数式の変更などのメンテナンスができないと思いますので(表示条件が複雑になるほど数式が複雑になります)、関数ではなく、フィルタオプションの設定などの一般機能を利用した方法で、該当データを抽出する方法を利用されることをお勧めします。
    • good
    • 0
この回答へのお礼

ご回答有難うございます。
分かりやすく書いて頂き勉強になりました。
配列数式ではかなり重くなったので、別の方法でためそうと思います。

お礼日時:2011/10/03 18:33

こんばんは!


色々方法はあると思いますが、一例です。

↓の画像のようにSheet1に作業列を2列設けています。
(目障りであれば遠く離れた列にするか、作業列を非表示にします)

Sheet1の作業列1E2セルに
=IF(COUNTBLANK(A2:C2),"",A2&"_"&B2&"_"&C2)
作業列2のF2セルに
=IF(AND(COUNTIF($E$2:E2,E2)=1,A2&"_"&B2=Sheet2!$B$1&"_"&Sheet2!$B$2),ROW(),"")
という数式を入れオートフィルでずぃ~~~!っと下へコピーしておきます。

Sheet2のA5セルに
=IF(COUNT(Sheet1!F:F)<ROW(A1),"",INDEX(Sheet1!C:C,SMALL(Sheet1!F:F,ROW(A1))))
という数式を入れオートフィルで下へコピーすると
画像のような感じになります。

参考になれば良いのですが・・・m(_ _)m
「2つの条件で重複しないデータを抽出」の回答画像1
    • good
    • 0
この回答へのお礼

早速のご回答有難うございます。
画像まで付けて頂きとても参考になりました。ちょっと理解に時間かかりそうですが、実際の条件に修正して試してみようと思います。

あと書いてなかったので補足させていただきます。
実際シート1のデータは、月のデータで、列数が50くらいあり、行数は多くて10000くらいあります。
毎週くらいに更新して追加していく予定で、更新するたびに行数が増えていきます。
もし作業列の追加がない例があれば是非ご教授お願いします。

お礼日時:2011/10/02 00:25

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人が検索しているワード

このQ&Aと関連する良く見られている質問

Q2つのシート間での重複データのチェック

Excelについて教えてください。
以下の2つのシートがあります。

Sheet1
すずき 03-0000-0000
やまだ 03-1111-1111
たなか 03-2222-2222

Sheet2
03-1111-1111
03-4444-4444
03-0000-0000
03-2222-2222

Sheet1には名称と電話番号、Sheet2には別所から抽出した電話番号のみのデータがあります。
Sheet1のデータの中からSheet2に電話番号があるものだけを知りたいのですが、たとえばSheet1の 各行のC列 に Sheet2に一致する番号があった場合は●等付けるにはどうすればよいでしょうか。

よろしくお願いします

Aベストアンサー

シート1のC列に式を入れます。
=IF(ISNA(VLOOKUP(B1,Sheet2!A:A,1,FALSE))=TRUE,"-","●")

【式の説明】
シート1のセルB1の値が、シート2のA列に、存在する場合は●を、存在しない場合は-をセット。

QVBAを使用した、複数条件での重複チェック

VBA初心者です。
Excel2010を使用しています。
よろしくお願いします。

H列 国名が表示されています。
V列 文字列
W列 文字列

H列が「日本」の時は、V列で重複チェックする。

H列が、日本以外の時(アメリカ、ドイツなど)は
W列で重複チェックする。
ただし、W列が「除外」と入力されている行は、無視する。

どちらの場合も重複していたら、ひとつめを含めて
該当行のA〜Wまで黄色にする。

全て組み合わせた記入の仕方が分かりませんでした。わかる方、教えて下さい。よろしくお願いします。

Aベストアンサー

以下のマクロを標準モジュールへ登録してください。
Option Explicit
Public Sub 重複チェック()
Dim maxrow As Long
Dim row As Long
Dim dicT0 As Object
Dim dicT1 As Object
Dim key1 As Variant
Dim key2 As Variant
Dim key As Variant
Set dicT0 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set dicT1 = CreateObject("Scripting.Dictionary") ' 連想配列の定義

maxrow = Cells(Rows.Count, "H").End(xlUp).row 'sheet H列 最終行を求める
'既存の色を解除
Range("A2:W" & maxrow).Select
With Selection.Interior
.Pattern = xlNone
End With
For row = 2 To maxrow
key1 = Cells(row, "H").Value
If key1 = "日本" Then
key2 = Cells(row, "V").Value
Else
key2 = Cells(row, "W").Value
End If
If key1 = "日本" Or key2 <> "除外" Then
key = key1 & "|" & key2
If dicT0.exists(key) = True Then
dicT1(row) = True
dicT1(dicT0(key)) = True
Else
dicT0(key) = row
End If
End If
Next
For Each key In dicT1
Range("A" & key & ":W" & key).Select
With Selection.Interior
.Color = 65535
End With
Next
MsgBox ("完了")
End Sub

以下のマクロを標準モジュールへ登録してください。
Option Explicit
Public Sub 重複チェック()
Dim maxrow As Long
Dim row As Long
Dim dicT0 As Object
Dim dicT1 As Object
Dim key1 As Variant
Dim key2 As Variant
Dim key As Variant
Set dicT0 = CreateObject("Scripting.Dictionary") ' 連想配列の定義
Set dicT1 = CreateObject("Scripting.Dictionary") ' 連想配列の定義

maxrow = Cells(Rows.Count, "H").End(xlUp).row 'sheet H列 最終行を求める
...続きを読む


人気Q&Aランキング

おすすめ情報