Excelデータを条件毎に分類したい

質問

Sheet1に検索用のデータ表があります。Sheet2に条件が入っています。シート2の条件と合うシート1のデータにフラグをたてたいのですが、検索用のデータ量、条件件数共にかなりあります。（その為、シートをわけました）。マクロを色々作ってみたのですが、どうしても上手く出来ません。シート1の各データがどの条件のものか判ればいいのですが。イメージでは下記の様になればいいのですが（簡略化していますが）。

シート1
　A　　B　　C
　課　品番　単価
1　E 　123　 450
2　A 　223　 350
2　E 　123　 450

シート2
　A　　B　　C D
　課　品番　単価 フラグNo
1　 E 　123　 450　1
1　 A 　223　 350　2
　　　↓
結果（マクロ処理後）
シート1
　A　　B　　C D
　課　品番　単価 フラグNo
1　E 　123　 450　1
2　A 　223　 350　2
1　E 　123　 450　1

回答No.6

Wendy02

こんばんは。

この方法で、列をループしてもよいし、
buf1 = buf1 & vbTab & .Cells(i, j).Value

オートフィルタをつなげてもよいし、
.AutoFilter Field:=1, Criteria1:=Sh2.Cells(i, 1).Value

＞質問の件自体をどうするのか、諦めるのか、もう一度質問し直すのか何らかの結論をお伝えしないと、

一体、何が問題になっているのかなっていう印象です。私にとっては、さほど、難しい内容でもありません。少なくとも、10日も掛かるようなものではありません。ダメならダメと、はっきりしていただいたほうが、こちらとしては楽なんですが。時々、質問が、相手に良く伝わらないで、迷宮入りという方はいらっしゃいます。私は、VBAに関しては、人に理解できるように、自分の解答レベル自体を落としたり、必要以上にコメントや解説を加えたりということはいたしません。それは、分る人には説明しなくてもわかるし、分らない人には、説明しても掲示板レベルでは伝わらないのです。

回答No.5

Wendy02

こんにちは。Wendy02です。

後々考え直してみて、ご自身で、マクロで作りたかったら、それは、ご自身の説明をまじえて、その旨を提示してくださいね。私たちが書いた後に、それに対して、その方法は違う、自分で考えます、というのは、ちょっと、話の順序が違うような気がします。

＞空白なら検索列も空白の物を読込んでしまう為、今回の場合では適応しないのです。

私の考えた方法に間違いがなかったことを証明するために、作ってみました。単なる区切り文字の「ある・なし」だけのことですから、それでダメ出しされたら敵いません。

'--------------------------------------------------
Sub ArrayChecker()
　 Dim Sh1 As Worksheet
　 Dim Sh2 As Worksheet
　 Dim myData As Variant
　 Dim buf1 As String
　 Dim mySearch As Variant
　 Dim mySearch2 As Variant
　 Dim buf2 As String
　 Dim buf3 As Integer
　 Dim LastCol As Integer
　 Dim i As Long, j As Long
　 Dim n As Long, m As Long, k As Long, l As Long
　 Dim Ret As Variant
　 Set Sh1 = Worksheets("Sheet1")
　 Set Sh2 = Worksheets("Sheet2")
　 With Sh1.Range("A1").CurrentRegion
　　　LastCol = .Columns.Count
　　　ReDim myData(1 To .Rows.Count - 1)
　　　For i = 2 To .Rows.Count
　　　　 For j = 1 To .Columns.Count
　　　　　　buf1 = buf1 & vbTab & .Cells(i, j).Value
　　　　 Next j
　　　　 myData(i - 1) = Mid$(buf1, 2)
　　　　 buf1 = ""
　　　Next i
　 End With
　 With Sh2.Range("A1").CurrentRegion
　　　ReDim mySearch(1 To .Rows.Count - 1)
　　　ReDim mySearch2(1 To .Rows.Count - 1)
　　　For m = 2 To .Rows.Count
　　　　 For n = 1 To .Columns.Count - 1
　　　　　　buf2 = buf2 & vbTab & .Cells(m, n).Value
　　　　 Next n
　　　　 mySearch(m - 1) = Mid$(buf2, 2)
　　　　 mySearch2(m - 1) = .Cells(m, n).Value
　　　　 buf2 = ""
　　　Next m
　 End With
　 ReDim Ret(1 To UBound(myData), 0)
　 For k = LBound(myData) To UBound(myData)
　　　For l = LBound(mySearch) To UBound(mySearch)
　　　　 On Error Resume Next
　　　　 buf3 = 0
　　　　 buf3 = WorksheetFunction.Match(myData(k), mySearch, 0)
　　　　 On Error GoTo 0
　　　　 If buf3 > 0 Then
　　　　　　Ret(k, 0) = mySearch2(buf3)
　　　　　　Exit For
　　　　 End If
　　　Next l
　 Next k
　 Sh1.Cells(2, LastCol + 1).Resize(UBound(Ret, 1)) = Ret

　 Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

'--------------------------------------------------

補足

＞私たちが書いた後に、それに対して、その方法は違う、自分で考えます、というのは、ちょっと、話の順序が違うような気がします。

何か、誤解されているようなので一言ご説明させていただきます。まず、最初に当然の事ですが、こちらに質問をさせていただく前に、思いつく限りのキーワードでヒットした過去の質問は全てチェック致しましたし、マクロのマニュアル本も数冊は読みましたし、結果を得られるであろうと思われる様々な方法を考え、作成したマクロもかなりの数になりました。それでも余程、私の理解力がないのか上手く対処できなかったので、質問をさせていただいたのです。ですが、私が言葉足らずだった為、やりたかった事が伝わらずにお答えをいただいたようなので、その旨をご説明し、お詫びとお礼を申し上げた上で、質問の件自体をどうするのか、諦めるのか、もう一度質問し直すのか何らかの結論をお伝えしないと、回答してくださる方もお困りになるだろうと思い、「もう少し考える」と申し上げたのです。内輪の事情ですが、この処理は業務命令の為、どんな事をしても近日中にこの処理を終えなければならず、少しでも効率よくする為に何か方法を考えないといけなかったのです。私としては、自分が考えた方法の1つを参考の意味で例に挙げただけで、それに固執する気も、貴方の考え方に異を唱える気も全くありませんし、まして「安易に他人に尋ねて、思ったような結果が得られなかったから、仕方がないから自分で考えよう」という事では決してないのです。
そこの所はご理解していただきたいのですが。

回答No.4

Wendy02

追伸:

もしも、検索がおかしい場合は、
Sh2.Cells(i, 1).Value
のところのプロパティを、
　Sh2.Cells(i, 1).Text
のようにTextに変更してください。通常の検索では、問題ありませんが、時々、ヒットしないことがあります。

回答No.3

Wendy02

こんばんは。

フィルタオプションではなくて、たぶん、オートフィルタのように思いますね。
たぶん、こういうことだと思います。そこに数はいくつでもよいわけですからね。

Sub FilterUsedChecker()

Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Set Sh1 = Worksheets("Sheet1")
Set Sh2 = Worksheets("Sheet2")
Application.ScreenUpdating = False
With Sh1.Range("A1").CurrentRegion
For i = 2 To Sh2.Range("A65536").End(xlUp).Row
　.AutoFilter Field:=1, Criteria1:=Sh2.Cells(i, 1).Value
　.AutoFilter Field:=2, Criteria1:=Sh2.Cells(i, 2).Value
　.AutoFilter Field:=3, Criteria1:=Sh2.Cells(i, 3).Value
　On Error Resume Next
　 .Columns(4).Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Value = Sh2.Cells(i, 4).Value
　On Error GoTo 0
Next
.AutoFilter
End With
Application.ScreenUpdating = True

Set Sh1 = Nothing: Set Sh2 = Nothing
End Sub

補足

仕事が立て込んでおり、お礼が遅くなってしまい、失礼致しました。処理を確認させていただきました。列数に関しては・AutoFilter Field:=～を増やし、
.Columns(4).～の列Noを変える事で仰るとおりに上手く出来ました。有難うございました。ただ、最初に説明不足をお詫びしたのですが、まだ上手く伝わってなかったようですね。仮にＡ～Ｅ列まであるデータが100行あるとします。これを抽出する条件として、Ｂ列に「あ」、Ｃ列に「い」、Ｄ列に「う」と入力した場合、指定した列と条件があっているデータは全て抽出したかったのです（Ａ、Ｅの条件は問わない）。作成していただいたマクロではＡ列＝空白、Ｂ列＝「あ」、Ｃ列＝「い」、Ｄ列＝「う」、Ｅ列＝空白　のデータのみの抽出ですので、私の意図するところとちょっと違うのです。お手間を取らせて申し訳ございませんでした

回答No.2

Wendy02

こんにちは。
＞シート1のデータにフラグをたてたいのですが

分岐しないのですすから、フラグではなく、ただのデータだと思いますが、#1さんの考え方をそのままマクロに移植してもよいですし（SUMPRODUCTは必要ありません）、少し内容が変わりますが、マクロに移植する場合は、早い話、1次元データにして比較すればよいわけです。

'なるべく標準モジュールに登録してください。
'-----------------------------------------------------------

Sub MatchUsedFind()
　 Dim myData As Variant
　 Dim SearchRange As Range
　 Dim Sh2 As Worksheet
　 Dim rw As Variant
　 Dim i As Long, j As Long
　 Dim k As Long
　 Set Sh2 = Worksheets("Sheet2")

　 With Sh2.Range("A1").CurrentRegion
　 ReDim myData(.Rows.Count)
　 For Each rw In .Rows
　　　　myData(k) = rw.Cells(1).Text & rw.Cells(2).Text & "\" & rw.Cells(3).Value2
　　　　k = k + 1
　 Next rw
　 End With

　 Application.ScreenUpdating = False
　 '2行目から (Sheet1の記述は省く)
　 With Range("A1").CurrentRegion
　　　For i = 2 To .Rows.Count
　　　　 On Error Resume Next
　　　　 j = 0
　　　　 j = WorksheetFunction.Match(.Cells(i, 1).Text & .Cells(i, 2).Text & "\" & .Cells(i, 3).Value2, _
　　　　 myData, 0)
　　　　 On Error GoTo 0
　　　　 'シート2からデータを取る
　　　　 If j > 0 Then .Cells(i, 4).Value = Sh2.Cells(j, 4).Value
　　　Next
　 End With

　 Set SearchRange = Nothing: Set Sh2 = Nothing
　 Application.ScreenUpdating = True
End Sub

'-----------------------------------------------------------

補足

お答えいただき、有難うございました。ただ、回答No1の方にも申し上げましたが、データ量が行だけでなく列数もかなりあり、条件において空白列もある為、A列対A列というような各列対応でチェックしていくような物だと条件列が空白なら検索列も空白の物を読込んでしまう為、今回の場合では適応しないのです。私の言葉が足らなかった為、お時間をとらせてしまい申し訳ございませんでした。私が考えたのは、フィルタオプションで条件1行目に適応するデータを抽出し、対応Noを入力、これを条件シートの最終行まで繰返す、という方法なのですが、マクロがどうしても上手く出来ないので…。1シート＝ひと月分なのですが、これを3年間分処理をしないといけない為、手動では時間がかかりすぎマクロ処理をしたかったのです。もう少し考えて見ます。有難うございました

回答No.1

mshr1962

フラグが数値なら
D2=SUMPRODUCT((シート２!$A$2:$A$100=$A2)*(シート２!$B$2:$B$100=$B2)*(シート２!$C$2:$C$100=$C2)*(シート２!$D$2:$D$100))

数値でない場合はフラグの前に１列追加
シート２で
D2=A2&B2&TEXT(C2,"000000")
シート１で
D2=VLOOKUP(A2&B2&TEXT(C2,"000000"),シート２!$D$2:$E$100,2,FALSE)

補足

早速のお答えを有難うございました。SUMPRODUCTってこういう使い方も出来るんですね。勉強になりました。ただ、私の説明が言葉足らずで申し訳ないのですが、条件の項目列も10列以上あり、かつ全ての列に条件が入っているわけではないのです。1行目の条件はA,B,E,F列にそれぞれ条件が入っており、2行目の条件はB,C,E列に条件が入っている…といった状況です。
この場合だと、空白列があるので、残念ながら対応できないようです。お答えは別の時に利用させていただきます