EXCELでのデータ抽出方法

質問

EXCEL2003を使用して次のような条件で式を作成したいと思っております。

下記表B列には、生徒から提出された課題が入力されています。
表は3行ごとに一つのグループになっています。

B列3行(一つのグループ)を見て、各自提出した課題の種類をC列の最初の行に表示させたいです。
尚、重複している課題は一つのみ表示します。

分かりずらい説明で申し訳ございませんが、ご教示よろしくお願い致します。

　　　　　A列　　　　　　B列　　　　　C列

　　　　提出者　　　　　課題　　　データ表示列
----------------------------------------------------------
１　　　　　Ａ　　　　　　　課題Ａ　　　　　　課題A
２　　　　　B
３　　　　　C
----------------------------------------------------------
4　　　　　D　　　　　　　　　　　　　　　　　課題A
５　　　　　E　　　　　　　課題Ａ
６　　　　　F　　　　　　　課題Ａ
----------------------------------------------------------
７　　　　　G　　　　　　　課題C　　　　　　課題C
８　　　　　H　　　　　　　課題B　　　　　　課題B
９　　　　　I　　　　　　　　課題A　　　　　　課題Ａ
----------------------------------------------------------
１０　　　　J　　　　　　　　　　　　　　　　　課題C
１１　　　　K
１２　　　　L　　　　　　　課題C
----------------------------------------------------------

回答No.7

imogasi

関数でやろうとすると難しい式になる。
既に出ている関数の回答の長く難しいこと。
VBAが出来なければしょうがないが、VBAなら素直に条件をプログラムに組み込める。
例データ
A列　　　　　B列　　　　　　　　　　　D列（VBA実行結果）
提出者 課題 データ表示列
Ａ 課題Ａ 課題Ａ
B
C
D 課題Ａ 課題Ａ
E 課題Ａ
F 課題Ａ
G 課題C 課題C
H 課題B 課題B
I 課題Ａ 課題Ａ
J 課題C 課題C
K
L 課題C
質問の例データも、このように書いてくれれば、すっきりしてわかりやすいのではないか。あと３行単位で考えることを添えて。
あと課題AのAは皆統一した。質問文では気をつけて。または別なら注記して。
ーー
VBAコード
Sub test01()
Dim sh1
Set sh1 = Worksheets("Sheet1")
d = sh1.Range("A65536").End(xlUp).Row
For i = 2 To d Step 3 '3行づつとらえる
Set rng = sh1.Range(sh1.Cells(i + 0, "D"), sh1.Cells(i + 2, "D")) 'D列で３行づつとらえる
j = i: k = i
'---
For j = 0 To 2 '３行内の各行処理
If sh1.Cells(i + j, "B") <> "" Then 'B列が空白で無ければ
y = sh1.Cells(i + j, "B") 'B列の値取得
x = Application.WorksheetFunction.CountIf(rng, y) 'D列３行で同じものが既に無いか
MsgBox x
If x = 0 Then '同じものが無ければD列に増やす
sh1.Cells(k, "D") = sh1.Cells(i + j, "B")
k = k + 1 'D列で下の行をポイント
End If
End If
Next j
Next i
End Sub
コメントだけでも参考に。
上記D列が実行結果。
私は仕事でエクセルを使うには、VBAの仕様は必須だという持論。
ーー
２－３百人程度なら手作業でコピペするほうが回答を待って理解して、自分の場合に式を修正してより速い。
スペース行を省き、かつ３行内で同じ行は省く、VBAを作って手作業の再に使う手もある。

回答No.6

mu2011

一例です。
重複分は不要という事なのでＶＢＡを使用しました。
対象のシートタブ上で右クリック→コードの表示→以下のサンプルコードを貼り付け→Ｆ５キー押下

Sub sample()
Set Db = CreateObject("Scripting.Dictionary")
For i = 2 To Cells(Rows.Count, "B").End(xlUp).Row Step 3
For j = 0 To 2
If Cells(i + j, "B").Value <> "" Then
Db(Cells(i + j, "B").Value) = 1
End If
Next j
wk = Db.keys
For k = 0 To Db.Count - 1
Cells(i + k, "C").Value = wk(k)
Next k
Db.RemoveAll
Next i
End Sub

回答No.5

KURUMITO

C2セルには次の式を入力して下方にオートフィルドラッグします。

=IF(MOD(ROW(A1),3)=1,IF(B2<>"",B2,IF(B3<>"",B3,IF(B4<>"",B4,""))),IF(MOD(ROW(A1),3)=2,IF(AND(B2<>"",B2<>C1),B2,IF(AND(B3<>"",B3<>C1),B3,"")),IF(MOD(ROW(A1),3)=0,IF(AND(B2<>"",COUNTIF(OFFSET(C1,-1,0):C1,B2)=0),B2,""))))

回答No.4

kagakusuki

回答番号ANo.3です。
　申し訳御座いません、

>尚、重複している課題は一つのみ表示します。

と言う箇所を見落としておりました。
　先程の回答の関数は、重複の除外には対応しておりません。
　重複を除外する場合には、以下の様な方法があります。

　今仮に、Sheet1に

　　　　　　　　A列　　　　　　　B列　　　　　　　C列

1行目　　　　提出者　　　　　課題　　　　データ表示列
2行目　　　　　Ａ　　　　　　　課題Ａ　　　　　　課題A
3行目　　　　　B
4行目　　　　　C
5行目　　　　　D　　　　　　　　　　　　　　　　　課題A
6行目　　　　　E　　　　　　　課題Ａ
7行目　　　　　F　　　　　　　課題Ａ
8行目　　　　　G　　　　　　　課題C　　　　　　課題C
9行目　　　　　H　　　　　　　課題B　　　　　　課題B
10行目　　　　I　　　　　　　　課題A　　　　　　課題Ａ
11行目　　　　J　　　　　　　　　　　　　　　　　課題C
12行目　　　　K
13行目　　　　L　　　　　　　課題C

という形に表を作成するものとします。
　又、Sheet2のA列を作業列として使用するものとします。

　まず、Sheet2のA2セルに次の数式を入力して下さい。

=IF(COUNTIF(OFFSET(Sheet1!$B$1,FLOOR(ROWS(Sheet1!$B$1:$B2)-2,3)+1,,MOD(ROWS(Sheet1!$B$1:$B2)-2,3)+1),Sheet1!$B2)=1,ROW(),"")

　次に、Sheet2のA2セルをコピーして、Sheet2のA3以下に貼り付けて下さい。

　次に、Sheet1のC2セルに次の数式を入力して下さい。

=IF(MOD(ROWS($B$1:$B2)-2,3)<COUNT(OFFSET(Sheet2!$A$1,FLOOR(ROWS($B$1:$B2)-2,3)+1,,3)),INDEX($B:$B,SMALL(OFFSET(Sheet2!$A$1,FLOOR(ROWS($B$1:$B2)-2,3)+1,,3),MOD(ROWS($B$1:$B2)-2,3)+1)),"")

　そして、Sheet1のC2セルをコピーして、Sheet1のC3以下に貼り付けて下さい。

回答No.3

kagakusuki

今仮に、

　　　　　　　　A列　　　　　　　B列　　　　　　C列

1行目　　　　提出者　　　　　課題　　　データ表示列
2行目　　　　　Ａ　　　　　　　課題Ａ　　　　　　課題A
3行目　　　　　B
4行目　　　　　C
5行目　　　　　D　　　　　　　　　　　　　　　　　課題A
6行目　　　　　E　　　　　　　課題Ａ
7行目　　　　　F　　　　　　　課題Ａ
8行目　　　　　G　　　　　　　課題C　　　　　　課題C
9行目　　　　　H　　　　　　　課題B　　　　　　課題B
10行目　　　　I　　　　　　　　課題A　　　　　　課題Ａ
11行目　　　　J　　　　　　　　　　　　　　　　　課題C
12行目　　　　K
13行目　　　　L　　　　　　　課題C

という形に表を作成するものとします。
　その場合、まず、C2セルに次の数式を入力して下さい。

=IF(MOD(ROWS($1:2)-2,3)<COUNTIF(OFFSET($B$1,FLOOR(ROWS($1:2)-2,3)+1,,3),"*"),INDEX($B:$B,SUMPRODUCT(ROW(OFFSET($B$1,FLOOR(ROWS($1:2)-2,3)+1,,3))*(OFFSET($B$1,FLOOR(ROWS($1:2)-2,3)+1,,3)<>"")*(COUNTIF(OFFSET($B$1,FLOOR(ROWS($1:2)-2,3)+1,,ROW(INDIRECT("Z1:Z3"))),"*")=MOD(ROWS($1:2)-2,3)+1))),"")

　そして、C2セルをコピーして、C3以下に貼り付けて下さい。

回答No.2

MackyNo1

関数で対応するなら、力技になりますが、例えば以下のような数式で表示できます。

C2セル
=IF(B2<>"",B2,IF(B3<>"",B3,B4&""))

C3セル
=IF(MAX(INDEX((B2:B4=C2)*ROW(B2:B4),))>=ROW(B4),"",IF(OFFSET($B$1,MAX(INDEX((B2:B4=C2)*ROW(B2:B4),)),0)&""<>"",OFFSET($B$1,MAX(INDEX((B2:B4=C2)*ROW(B2:B4),)),0),B4&""))

C4セル
=IF(AND(COUNTA(B2:B4)=3,B2<>B3,B3<>B4,B2<>B4),B4,"")

上記3つのセルを選択して下方向にオートフィルコピーしてください。

回答No.1

tom04

こんばんは！
関数ではなく、VBAでの一例ですので、参考にならなかったら読み流してください。

画面左下にある操作したいSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt＋F8キー　→　マクロ　→　マクロ実行です）

Sub test() 'この行から
Dim i, j As Long
Columns(4).Insert
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 3
Range(Cells(i, 2), Cells(i + 2, 2)).Copy
Cells(1, 4).Select
ActiveSheet.Paste
For j = 3 To 1 Step -1
If WorksheetFunction.CountIf(Range(Cells(1, 4), Cells(j, 4)), Cells(j, 4)) > 1 _
Or Cells(j, 4) = "" Then
Cells(j, 4).Delete (xlUp)
End If
Next j
Range(Cells(1, 4), Cells(3, 4)).Copy
Cells(i, 3).Select
ActiveSheet.Paste
Next i
Columns(4).Delete
Cells(1, 1).Select
End Sub 'この行まで

※　無理矢理って感じのコードですがこの程度しか思いつきませんでした。m(_ _)m