エクセルの検索関数

質問

エクセルのVlookup関数など検索方法で、例えば、

「赤白黄緑」のうち一番多く連続して一致している色があるセルを検索したい場合なのですが。。

１　白黄青　　　　　白黄の２つが一致
２　黄緑桃赤　　　　黄緑の２つと赤１つが一致
３　紫赤　　　　　　赤の１つだけが一致
４　緑黄白赤　　　　順番が違う為それぞれ１つが一致
５　赤紫黄　　　　　連続してない為赤と黄の１つづつが一致

となってた場合２行目が一番多く一致しているので、検出させる方法はないでしょうか?
あるいは１行目、２行目の両方を検出させる方法でもいいと思います。

Vlookは普通は一番最初に検索された値を返しますが、一致するものが２つ以上ある場合、全てを返す方法はないでしょうか？

なかなか説明しづらかったのですが、宜しくお願い致します。

回答No.5

pauNed · ベストアンサー

失礼しましたm(_ _)m

念の為。

【手順】
1)目的のシートをActiveにして、[Alt]キー+[F11]キー同時押し。
　VisualBasicEditor（VBE）が起動します。
2)そのVBE画面で[Alt]キー → [i]キー → [m]キー の順押し。
　標準モジュールが挿入され、マウスカーソルが無地シートのようなものにフォーカスします。
　（コードウィンドウといいます）
3)そこに先ほどの Sub try1() や Sub try2() をコピーペーストします。

Sub try1()
：
（略）
：
End Sub

4)上記コード内のどこでも良いので、マウスカーソルを置いて、[F5]キーで実行です。
（もしくは、Excel側[ツール]-[マクロ]-[マクロ]からでも実行できます）

もし、マクロ、VBAに興味を持たれたら、
http://www.sanynet.ne.jp/~awa/excelvba/kouza.html
http://excelvba.pc-users.net/
http://www.asahi-net.or.jp/~ef2o-inue/top01.html
など、Netだけでも結構勉強できます。

補足

色々教えていただいてどうも有り難うございますｍ（__）ｍ
是非参考にさせていただきたいと思います。

回答No.4

pauNed

こんにちは。
『一番多く連続して一致している色があるセルを検索したい場合』

作業列に
=SUM(ISNUMBER(FIND({"赤","白","黄","緑","赤白","白黄","黄緑","赤白黄","白黄緑","赤白黄緑"},A1))*{1,1,1,1,2,2,2,3,3,4})

こんな式だと、連続一致優先で点数が高くなるので、その結果のMAXを得れば良いです。
マクロで、一気に選択させるまで持っていくには、上記式の考え方を流用して

Sub try1()
　　Dim r　As Range
　　Dim s　As String
　　Dim s1 As String
　　Dim s2 As String
　　Dim x　As Long
　　Dim mx As Long

　　s1 = "{""赤"",""白"",""黄"",""緑"",""赤白"",""白黄"",""黄緑"",""赤白黄"",""白黄緑"",""赤白黄緑""}"
　　s2 = "{1,1,1,1,2,2,2,3,3,4}"
　　For Each r In Range("A1", Range("A1").End(xlDown))
　　　　x = Evaluate("SUM(ISNUMBER(FIND(" & s1 & ",""" & r.Value & """))*" & s2 & ")")
　　　　If x >= mx Then
　　　　　　If x > mx Then s = ""
　　　　　　s = s & "," & r.Address
　　　　　　mx = x
　　　　End If
　　Next r
　　If mx > 0 Then Range(Mid$(s, 2)).Select
End Sub

"赤白黄緑"の条件が変動するなら

Sub try2()
　　Dim arg As String
　　Dim ad　As String
　　Dim s　 As String
　　Dim r　 As Range
　　Dim i　 As Long
　　Dim j　 As Long
　　Dim k　 As Long
　　Dim n　 As Long
　　Dim x　 As Long
　　Dim mx　As Long
　　Dim vi

　　arg = "赤白黄緑" 'Range("B1").Value 'など任意
　　n = Len(arg)
　　ReDim v(1 To (n + 1) * n / 2)
　　For i = 1 To n
　　　　For j = 1 To n - i + 1
　　　　　　k = k + 1
　　　　　　v(k) = Mid$(arg, j, i)
　　　　Next j
　　Next i
　　For Each r In Range("A1", Range("A1").End(xlDown))
　　　　x = 0
　　　　s = r.Value
　　　　For Each vi In v
　　　　　　If s Like "*" & vi & "*" Then x = x + Len(vi)
　　　　Next vi
　　　　If x >= mx Then
　　　　　　If x > mx Then ad = ""
　　　　　　ad = ad & "," & r.Address
　　　　　　mx = x
　　　　End If
　　Next r
　　If mx > 0 Then Range(Mid$(ad, 2)).Select
End Sub

補足

回答有難うございました。
ちょっと私には難しいので、勉強してみます。
有難うございました。
また理解して、返信します。

回答No.3

mitarashi

VBAではお世話になっている立場ですが、頭の体操で取り組んでみました。
質問者の意図されている様な、すっきりしたものではありませんが。
A1:A5に検索対象のデータを置いて実行すると、B,C列に中間結果、D列に該当する最大の並び、E列に並びの合計を表示します。
ご参考になれば幸いです。
※インデントが投稿時に消えてしまい、見難いですがご容赦下さい。
Sub test()
Dim i As Integer, j As Integer
Dim oneChar As String, nextChar As String
Dim tempString As String
Dim charPos As Integer
Dim tempArray As Variant
Dim maxSeries As Integer, sum As Integer
Const lastRow As Integer = 5
Const delimiter As String = "@"

'並び順に応じた数字、該当しない場合はデリミタ（ここでは@）に置換
For i = 1 To lastRow
tempString = Cells(i, 1).Value
For j = 1 To Len(Cells(i, 1).Value)
oneChar = Mid(tempString, j, 1)
Select Case oneChar
Case "赤"
tempString = Replace(tempString, oneChar, "1")
Case "白"
tempString = Replace(tempString, oneChar, "2")
Case "黄"
tempString = Replace(tempString, oneChar, "3")
Case "緑"
tempString = Replace(tempString, oneChar, "4")
Case Else
tempString = Replace(tempString, oneChar, delimiter)
End Select
Next j
Cells(i, 2).Value = tempString
Next i

'数字の並びが、一つ増加になっていない場合、間にデリミタを入れる
For i = 1 To lastRow
tempString = Cells(i, 2).Value
charPos = 1
For j = 1 To Len(tempString)
oneChar = Mid(tempString, charPos, 1)
nextChar = Mid(tempString, charPos + 1, 1)
'両文字が数字の時
If Val(nextChar) * Val(oneChar) <> 0 Then
If Val(nextChar) - Val(oneChar) <> 1 Then
tempString = Replace(tempString, oneChar, oneChar & delimiter)
charPos = charPos + 2
End If
Else
charPos = charPos + 1
End If
Next j
Cells(i, 3).Value = tempString
Next i

'デリミタにより文字列を分割して、最大の長さ及び長さの合計を求める
For i = 1 To lastRow
maxSeries = 0
sum = 0
tempString = Cells(i, 1 + 2).Value
tempArray = Split(tempString, delimiter)
For j = 0 To UBound(tempArray)
If Len(tempArray(j)) > maxSeries Then
maxSeries = Len(tempArray(j))
End If
sum = sum + Len(tempArray(j))
Next j
Cells(i, 4).Value = maxSeries
Cells(i, 5).Value = sum
Next i
End Sub

補足

回答有難うございました。
ちょっと私には難しいので、勉強してみます。
有難うございました。
また理解して、返信します。

回答No.2

imogasi

関数はセルの値として１つの値しか返しません。ですからVLOOKUPやMATCH関数やFIND関数を
考えても無駄です。配列数式というのも、１セルの値は１つです。
この課題は難しい質問かなと思います。
同じことをVBAでやるほうが素直な構想でプログラムが組めます。
ーー
例データ
A1:A5
A列　　B列
白黄青 2
黄緑桃赤 3
紫赤 1
緑黄白赤　 4
赤紫黄　 2
ーー
B1に
=SUM(IF(ISERROR(FIND({"赤","白","黄","緑"},A1)),0,1))
ト入れてSHIFT,CTRL,ENTERを同時押しします（配列数式）
その式をA5まで複写します。
ーー
結果
上記の通り。
これは”赤","白","黄","緑"のうち、そのセルの文字でで見つかった個数を出してます。
ーー
別の式で
=SUMPRODUCT(IF(ISERROR(FIND({"赤","白","黄","緑"},A1:A5)),0,1))
としてした方向に式を複写しても同じです。
ーー
このB列での=MAX（B1:B5) の４が最多です。
これを一発で出そうとやってますが、現状うまくいってません。
とりあえず、挙げます。

補足

回答有難うございました。
ちょっと私には難しいので、勉強してみます。
有難うございました。
また理解して、返信します。

回答No.1

master000

大学の課題のようだ。

使えるかなという機能を上げておきます。
match, count, rank, 配列数式

お礼

返信有難うございます。
やってみます。