こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルの検索関数

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

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

1 白黄青     白黄の2つが一致
2 黄緑桃赤    黄緑の2つと赤1つが一致
3 紫赤      赤の1つだけが一致
4 緑黄白赤    順番が違う為それぞれ1つが一致
5 赤紫黄     連続してない為赤と黄の1つづつが一致

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

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

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

投稿日時 - 2007-11-02 14:55:50

QNo.3482983

困ってます

質問者が選んだベストアンサー

失礼しました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だけでも結構勉強できます。

投稿日時 - 2007-11-05 17:41:06

補足

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

投稿日時 - 2007-11-05 18:04:59

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(5)

ANo.4

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

作業列に
=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

投稿日時 - 2007-11-05 15:10:29

補足

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

投稿日時 - 2007-11-05 16:34:27

ANo.3

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

投稿日時 - 2007-11-03 14:39:26

補足

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

投稿日時 - 2007-11-05 16:32:59

ANo.2

関数はセルの値として1つの値しか返しません。ですからVLOOKUPやMATCH関数やFIND関数を
考えても無駄です。配列数式というのも、1セルの値は1つです。
この課題は難しい質問かなと思います。
同じことを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) の4が最多です。
これを一発で出そうとやってますが、現状うまくいってません。
とりあえず、挙げます。

投稿日時 - 2007-11-02 18:04:00

補足

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

投稿日時 - 2007-11-05 18:07:09

ANo.1

大学の課題のようだ。

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

投稿日時 - 2007-11-02 16:46:15

お礼

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

投稿日時 - 2007-11-02 17:40:59

あなたにオススメの質問