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.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つを参考の意味で例に挙げただけで、それに固執する気も、貴方の考え方に異を唱える気も全くありませんし、まして「安易に他人に尋ねて、思ったような結果が得られなかったから、仕方がないから自分で考えよう」という事では決してないのです。
そこの所はご理解していただきたいのですが。