教えて!gooグレードポイントがdポイントに!

初めて質問します
エクセルで画像の左ようにデータが並んでいるシートがあり
(・・・はデータがまだ続いています)
テスト結果に◯と△がどちらもいつ以上あった名前の人の結果を全て別シートに抽出したいです
画像の場合はAとDがどちらも◯と△があるので名前にA,Dと書かれている行を全て抜き出したいです(Aで結果がxの5行目も)
VBAや関数で抜き出せないでしょうか?
具体的なコードや式を教えていただきたいです
写真は例で別の表に当てはめるので内容を詳しく教えていただけると助かります

「エクセルのマクロで複数条件に当てはまるも」の質問画像
教えて!goo グレード

A 回答 (7件)

以下のマクロを標準モジュールに登録してください。


左側のシートをSheet1,右側のシートをSheet2とします。
Sheet2に抽出結果が表示されます。

Option Explicit
Public Sub 複数条件抽出()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim dicT As Object
Dim maxrow1 As Long
Dim row1 As Long
Dim row2 As Long
Dim key As Variant
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
Set dicT = CreateObject("Scripting.Dictionary")
maxrow1 = sh1.Cells(Rows.count, "A").End(xlUp).Row
For row1 = 2 To maxrow1
key = sh1.Cells(row1, "C").Value
If dicT.exists(key) = False Then
dicT(key) = 0
End If
If sh1.Cells(row1, "D").Value = "○" Then
dicT(key) = dicT(key) Or 1
End If
If sh1.Cells(row1, "D").Value = "△" Then
dicT(key) = dicT(key) Or 2
End If
Next
sh2.Cells.ClearContents
sh2.Range("A1:D1").Value = sh1.Range("A1:D1").Value
row2 = 2
For Each key In dicT.keys
If dicT(key) = 3 Then
For row1 = 2 To maxrow1
If sh1.Cells(row1, "C") = key Then
sh2.Range("A" & row2 & ":D" & row2).Value = sh1.Range("A" & row1 & ":D" & row1).Value
row2 = row2 + 1
End If
Next
End If
Next
MsgBox ("完了")
End Sub
    • good
    • 0
この回答へのお礼

ご回答ありがとうございました
このマクロで無事抽出できました
1番早く回答いただきましたのでベストアンサーとさせていただきます
ありがとうございました

お礼日時:2022/05/23 10:26

とりあえず、フィルタをかける所まで書いてみました。


転記部分は、必要に応じて、ご自分で書いてみてください。

Sub sample()
Dim dicT As Object
Dim i As Long
Dim namae As Variant

Set dicT = CreateObject("Scripting.Dictionary")

For i = 1 To Range("テーブル1").Rows.Count
namae = Range("テーブル1[名前]").Rows(i).Value
If Not dicT.Exists(namae) Then
dicT.Item(namae) = WorksheetFunction.CountIfs(Range("テーブル1[名前]"), namae, Range("テーブル1[テスト結果]"), "○") > 0 And _
WorksheetFunction.CountIfs(Range("テーブル1[名前]"), namae, Range("テーブル1[テスト結果]"), "△") > 0
End If
Next i

For Each namae In dicT.Keys
If Not dicT.Item(namae) Then dicT.Remove (namae)
Next

Range("テーブル1").ListObject.Range.AutoFilter Field:=3, Criteria1:=dicT.Keys, Operator:=xlFilterValues

End Sub
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます
やってみたのですがフィルターで全て消えてしまいうまくできませんでした
他の方の回答で解決しました
ありがとうございます

お礼日時:2022/05/23 10:33

こんにちは


VBAのご希望もあるようなので大丈夫かな
シート情報もあいまいですが取り敢えず

シート名が明示されていないので
データ  "Sheet1" 出力先 "Sheet2"
出力前の"Sheet2"の書式、値は消しています

テーブルみたいに見えますが、、
情報が無いのでテーブルは考慮していません

テーブルでAutoFilterにエラーが生じる場合は

テーブルを解除してから実行するか
テーブルに対してのAutoFilter

With ActiveSheet.ListObjects("???")
.AutoFilter .ListColumns("名前").Index, k
のようになると思いますが、ご自身で改造してください

>写真は例で別の表に当てはめるので内容を詳しく教えていただけると助かります
名前別に どちらも◯と△がある条件での 単純なコピペを所望されていると理解しています
残念ですが割愛します
必要データだけを出力するようなコードではなくべたなロジックで情報の少ないメソッドは使っていないと思います
意味の解らない部分を質問してください、またステップ実行などで辿り、メソッド、コードなどで調べてください。

Sub test()
Dim List_Collection As New Collection
Dim k As Variant, c As Range
Dim flag1 As Boolean, flag2 As Boolean
Dim lastRow As Long, i As Long
Application.ScreenUpdating = False
Worksheets("Sheet2").UsedRange.ClearContents

With Worksheets("Sheet1")
.Range("A1").EntireRow.Copy Worksheets("Sheet2").Range("A1").EntireRow
lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
.AutoFilterMode = False
For i = 2 To lastRow
On Error Resume Next
List_Collection.Add .Cells(i, 1), .Cells(i, 1)
On Error GoTo 0
Next i
For Each k In List_Collection
If .AutoFilterMode = True Then .AutoFilterMode = False

.Range("A1").CurrentRegion.AutoFilter 1, k
For Each c In .Range("C2:D" & lastRow).SpecialCells(xlCellTypeVisible)
If c = "◯" Then flag1 = True
If c = "△" Then flag2 = True
Next
If flag1 = True And flag2 = True Then
.Range("A1").CurrentRegion.Offset(1).Copy _
Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
flag1 = False: flag2 = False
Next
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
    • good
    • 1
この回答へのお礼

ご回答ありがとうございます
自分がやりたかったデータに当てはめてみたのですが
うまく出来ず何も表示されませんでした
他の方の回答で解決しました
ありがとうございます

お礼日時:2022/05/23 10:38

No.4です。



ちょっと勘違いしてました。
フィルタと言うよりクエリでしたね。
パワークエリは未経験なのでごめんなさい。
    • good
    • 0

ところで抽出条件としてはどのように与えるのでしょう?


フィルタリングですか?
C列の値を”A”・”D”で抽出し範囲を指定してコピペじゃダメなのでしょうか?
    • good
    • 0
この回答へのお礼

ご回答ありがとうございます
本当はこの表ではなくもっと膨大なデータの表があるのですが会社のデータのため簡略化して書きました
少ないデータであればおっしゃる通りです!

お礼日時:2022/05/23 10:30

No2です。

使用時の注意事項です。
注意1:
○の文字は何種類かあります。文字コードの異なる○を使用すると期待した結果が得られません。
期待した結果が得られない場合、
Sheet1の○をマクロの○にコピペしてください。(それで文字コードが一致します。△も念のため行ってください)
If sh1.Cells(row1, "D").Value = "○" Then
If sh1.Cells(row1, "D").Value = "△" Then
の2行です。
注意2:
Sheet2のB列全体をセルの書式設定で「時刻」にしてください。
そうすると、時刻が正しく表示されます。
    • good
    • 0
この回答へのお礼

ありがとうございます
これを入れなくても無事抽出できましたが念の為入れておきます

お礼日時:2022/05/23 10:28

カメラでの撮影って相手がモニターですと見づらい物ですよ。



https://www.pc-koubou.jp/magazine/35994
を使うとして、必要のない列や詰められる列なら幅を狭め添付したい範囲を切り取り画像ファイルとして保存し載せるのが宜しいかと思います。
    • good
    • 0
この回答へのお礼

助言ありがとうございます
会社のPCで投稿するのに抵抗があり写真を撮ってスマホより投稿しました
次回より気をつけます

お礼日時:2022/05/23 10:23

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

このQ&Aを見た人はこんなQ&Aも見ています

教えて!goo グレード

このQ&Aを見た人がよく見るQ&A

人気Q&Aランキング