[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『条件抽出』（yoota）
お世話になります。 下表を例にお尋ねします。
（例表）
組03-06 組03-13 組06-13 組03-15 組09-17 組06-09 ・・・ 3.6 4.9 9.7 12.8 25.6 25.6 ・・・
・A1セル以降に「漢字1文字+数字－数字」の「組み」があります
（数字は「半角二桁」です）
・A2セル以降に数値が「昇順」に対応しています
A5セルに「昇順の第五位（組06-09；後述）までで最も多く出現する数字」を表示する式をご教授ください。
但し、以下のルールに従います。
（ルール）
・同回数の場合（03,06）は、「より小さい数値で多く出現する数字」を選択する（03）
・第五位が同数値の場合（組09-17,組06-09）、「より小さい数値で出現する数字を含む組み」を選択する（組06-09）
例表の場合、A5セル=03 となります。
よろしくお願いします。
追記-yoota
複雑な式になるようでしたら、初等レベルのマクロでもお願いします。
＜ 使用 Excel：Excel2010、使用 OS：Windows7 ＞
エキスパートさんたちから関数での回答がアップされるまでのつなぎで、マクロです。 できるだけ、マクロ内でシート関数や、シート上の操作を使いましたので、間延びしたコードですが。 また、シート上の操作を利用していますので、作業シート（仮に Sheet2)を使います。 データは Sheet1 にあるという前提です。
Sub Test()
Dim f As Long
Dim t As Long
Dim n As Long
Dim z As Long
Dim a As String
Dim x As Long
Dim j As Long
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim w As Variant
Sheets("Sheet1").Select 'データのあるシート シート関数を使うためにActivate
s1 = "MATCH(SMALL(A2:$2,5),A2:$2)"
s2 = "COUNTIF(A2:$2,SMALL(A2:$2,5))"
z = Cells(1, Columns.Count).End(xlToLeft).Column 'データ最終列
a = Split(Cells(1, z).Address, "$")(1) 'その列記号
s1 = Replace(s1, "$", a) '式の中の終了列記号を変換
s2 = Replace(s2, "$", a)
t = Evaluate(s1) '５位の最後の数の列
n = Evaluate(s2) '５位の数字の個数
f = t - n + 1 '５位の最初の数の列
'処理対象最終列を求める
For j = f To t
If x = 0 Then
x = j
s3 = Cells(1, j).Value
Else
If Cells(1, j).Value < s3 Then
x = j
s3 = Cells(1, j).Value
End If
End If
Next
w = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1").Resize(, x).Value)))
w = Replace(w, "組", "")
w = Replace(w, "-", " ")
w = Split(w)
'作業シートでのCOUNTIF、重複削除、並び替え
With Sheets("Sheet2") '作業シート
.UsedRange.ClearContents
.Range("A1").Resize(UBound(w) + 1).Value = WorksheetFunction.Transpose(w)
With .Range("A1").CurrentRegion
.Offset(, 1).Formula = "=COUNTIF(" & .Address & ",A1)"
.Offset(, 1).Value = .Offset(, 1).Value
End With
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Columns("B"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Columns("A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange .Parent.Range("A1").CurrentRegion
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5").Value = "'" & Format(.Range("A1").Value, "00") '結果の書き込み
.UsedRange.ClearContents
End With
End Sub
（β） 2015/02/09(月) 21:47
◆質問です １）「組03-06」は、「03」1回、「06」1回でしょうか？ ２）「組03-03」のケースはあるのでしょうか？・・この場合「03」2回になるのでしょうか？ ３）ルールの「・第五位が同数値の場合（組09-17,組06-09）」の意味がわかりません （組09-17,組06-09）では、第二位と第五位が同数字の場合ではないでしょうか？ （maron） 2015/02/10(火) 04:09
To (maron)さん
私が答える立場ではないですが、アップしたコードを書くときの、自分なりの解釈として 「五位」とは、２行目の数値で昇順の五位。なので、25.6 なんだろうと。 で、２つある、それらのどちらなのかというと、組09-17 と 組06-09 という値の小さなほう、 つまり、組06-09 。
まあぁ、質問者さんからの回答を待ちましょう。
（β） 2015/02/10(火) 08:21
あっ! ↑のコメントを書いて、ふと。
組03-06 というのを、私の解釈では、 03 「と」06 としています。 もしかしたら、03 「から」06、つまり、03,04,05,06 ということだったでしょうか？
（β） 2015/02/10(火) 09:24
「組03-**」みたいなのを抽出するのでなく「03」が結果なら 他にルールがあるんでしょうな。。。
もし xx－yy ＝ xxからyy なら
A B C D E F 1 組03-06 組03-13 組06-13 組03-15 組09-17 組06-09 COUNT 2 3.6 4.9 9.7 12.8 25.6 25.6
3 3 3 3 4 4 4 3 5 5 5 3 6 6 6 6 6 5 7 7 7 7 4 8 8 8 8 4 9 9 9 9 9 5 10 10 10 10 4 11 11 11 11 4 12 12 12 12 4 13 13 13 13 4 14 14 2 15 15 2 16 1 17 1
回答は「06」になりそうだしね。。。。
※「から」ではなく単純な組み合わせっぽいね。 （GobGob） 2015/02/10(火) 09:48
理解し切れてないので、あてずっぽ。
=0&LOOKUP(1,0/(MID(A1:INDEX(1:1,MATCH(SMALL(2:2,5),2:2)),2,2)*1=ROW($1:$99))+(RIGHT(A1:INDEX(1:1,MATCH(SMALL(2:2,5),2:2)),2)*1=ROW($1:$99)),ROW($1:$99)) （GobGob） 2015/02/10(火) 09:56
ありゃりゃ。ぜんぜん駄目だわｗ 仕切りなおしますわ。 （GobGob） 2015/02/10(火) 09:59
だらだらだら・・・・
=0&MATCH(MAX(MMULT((MID(A1:INDEX(1:1,MATCH(SMALL(2:2,5),2:2)),2,2)*1=ROW($1:$99))+(RIGHT(A1:INDEX(1:1,MATCH(SMALL(2:2,5),2:2)),2)*1=ROW($1:$99)),(ROW(A1:INDEX(A:A,MATCH(SMALL(2:2,5),2:2)))>0)*1)),MMULT((MID(A1:INDEX(1:1,MATCH(SMALL(2:2,5),2:2)),2,2)*1=ROW($1:$99))+(RIGHT(A1:INDEX(1:1,MATCH(SMALL(2:2,5),2:2)),2)*1=ROW($1:$99)),(ROW(A1:INDEX(A:A,MATCH(SMALL(2:2,5),2:2)))>0)*1),0) （GobGob） 2015/02/10(火) 10:08
03-06 が 03,04,05,06 だったとしたら以下。（コードがだんだん伏魔殿みたいに増殖？）
Sub Test2()
Dim f As Long
Dim t As Long
Dim n As Long
Dim z As Long
Dim a As String
Dim x As Long
Dim i As Long
Dim j As Long
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim w As Variant
Dim v As Variant
Dim y1 As Long
Dim y2 As Long
Dim tmp As Variant
Sheets("Sheet1").Select 'データのあるシート シート関数を使うためにActivate
s1 = "MATCH(SMALL(A2:$2,5),A2:$2)"
s2 = "COUNTIF(A2:$2,SMALL(A2:$2,5))"
z = Cells(1, Columns.Count).End(xlToLeft).Column 'データ最終列
a = Split(Cells(1, z).Address, "$")(1) 'その列記号
s1 = Replace(s1, "$", a) '式の中の終了列記号を変換
s2 = Replace(s2, "$", a)
t = Evaluate(s1) '５位の最後の数の列
n = Evaluate(s2) '５位の数字の個数
f = t - n + 1 '５位の最初の数の列
'処理対象最終列を求める
For j = f To t
If x = 0 Then
x = j
s3 = Cells(1, j).Value
Else
If Cells(1, j).Value < s3 Then
x = j
s3 = Cells(1, j).Value
End If
End If
Next
w = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1").Resize(, x).Value)))
w = Replace(w, "組", "")
w = Split(w)
For i = LBound(w) To UBound(w)
tmp = Split(w(i), "-")
y1 = Val(tmp(0))
y2 = Val(tmp(1))
For j = y1 To y2
If IsArray(v) Then
ReDim Preserve v(LBound(v) To UBound(v) + 1)
Else
ReDim v(0)
End If
v(UBound(v)) = j
Next
Next
'作業シートでのCOUNTIF、重複削除、並び替え
With Sheets("Sheet2") '作業シート
.UsedRange.ClearContents
.Range("A1").Resize(UBound(v) + 1).Value = WorksheetFunction.Transpose(v)
With .Range("A1").CurrentRegion
.Offset(, 1).Formula = "=COUNTIF(" & .Address & ",A1)"
.Offset(, 1).Value = .Offset(, 1).Value
End With
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlNo
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Columns("B"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=.Columns("A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort
.SetRange .Parent.Range("A1").CurrentRegion
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A5").Value = "'" & Format(.Range("A1").Value, "00") '結果の書き込み
.UsedRange.ClearContents
End With
End Sub
（β） 2015/02/10(火) 10:09
A B C D E F
1 組03-06 組03-13 組06-13 組03-15 組09-17 組06-09
2 3.6 4.9 9.7 12.8 25.6 25.6
3
4
5 03
6
7
8 03 03 06 03 09 06
9 06 13 13 15 17 09
10 3 3 2
11 2 1 1
◆条件の「・第五位が同数値の場合（組09-17,組06-09）」を無視すると A8=MID(A$1,2+MOD(ROW(),2)*3,2) ★A8の式をA8:F9にコピー
A10=IF((COUNTIF($A7:$F7,A8)+COUNTIF($A$8:A8,A8))=1,COUNTIF($A$1:$F$1,"*"&A8&"*"),"") ★A10の式をA10:F11にコピー
A5{=TEXT(MIN((A10:F11<>MAX(A10:F11))*100+A8:F9),"00")}
★A5の式を「配列数式」です
★式を入力後、CtrlとShiftを押しながらEnterを押して式を確定させてください
（maron） 2015/02/10(火) 11:00
>１）「組03-06」は、「03」1回、「06」1回でしょうか？
→ハイ、そうです。
>２）「組03-03」のケースはあるのでしょうか？・・この場合「03」2回になるのでしょうか？
→同数字の組合せはありません。
>３）ルールの「・第五位が同数値の場合（組09-17,組06-09）」の意味がわかりません
→「第五位」の文言が誤解を与えてしまいました。
昇順の「５番目」までの「組」を抽出の対象とし、５番目に同値のものがあれば
「より小さい数値で出現する数字を含む組み」を選択する．．に訂正させていただきます。
また、該当が複数の場合、A5セルには「複」と表示するようにしていただけますか？
例えば、１番目に「組02-10」がある時、02と10が同回数で出現トップとか、５番目の同値の
複数組に02,10が含まれるようなケースです。
あるいはこちらの想定外のケースがあるかも知れませんので、エラーや無限のループ？？に
陥ったような時は、とりあえず「外」と表示していただけると助かります。
平日はご回答の確認やレス遅くなりますが、よろしくお願いします。
（yoota） 2015/02/10(火) 11:20
ルール整理。
・2行目 5番目まで小さい数値の範囲。 ・1行目 頻度が多い数値を出す。 ・複数ある場合「小さい数値」を返す。 ・数値は 組AA-BB の 「AA」「BB」を対象に見る。
コレが基本。
んで、5番目が複数の場合は1行目データの数値が小さいトコまで範囲にする。
こんなかんじのような気がしてきた。 （GobGob） 2015/02/10(火) 11:59
マクロであれば最初のβさんので解決したのでしょうか。 関数はまだ回答待ちかな？
回答というよりはお遊びの出品なので、参考にならないと思いますが、短いコードに挑戦 してみました。 もう少し短くなりそうですけれど、とりあえずお遊びということで。
Sub Sample()
Dim sList As Object
Set sList = CreateObject("System.Collections.SortedList")
Dim r As Range
For Each r In Range("A2").Resize(1, ActiveSheet.UsedRange.Columns.Count)
If r.Value <> "" Then sList.Add r.Value - Application.Min(CDbl(Mid(r.Offset(-1).Value, 2, 2)), CDbl(Mid(r.Offset(-1).Value, 5, 2))) / 10 ^ 4 - Rnd() / 10 ^ 8, r.Offset(-1).Value
Next
Dim dList As Object
Set dList = CreateObject("Scripting.Dictionary")
Dim i As Long, k As Variant
For i = 0 To 4
For Each k In Array(Mid(sList.GetByIndex(i), 2, 2), Mid(sList.GetByIndex(i), 5, 2))
If dList.exists(k) Then dList(k) = dList(k) + 1 Else dList(k) = 1
Next
Next
sList.Clear
For Each k In dList.keys
sList.Add dList(k) + 10 ^ -3 - CDbl(k) / 10 ^ 4, k
Next
Range("A5").Value = Format(Int(sList.GetByIndex(dList.Count - 1)), "'00")
End Sub
（Mook） 2015/02/10(火) 13:06
だらだらだらだらだらだらだら・・・・
=0&MATCH(MAX(MMULT((MID(A1:INDEX(A1:O1,MATCH(0,INDEX(COUNTIFS(A2:O2,SMALL(A2:O2,5),A1:O1,"<"&A1:O1)+(A2:O2<SMALL(A2:O2,5))*100,),0)),2,2)*1=ROW(A1:A99)) +(RIGHT(A1:INDEX(A1:O1,MATCH(0,INDEX(COUNTIFS(A2:O2,SMALL(A2:O2,5),A1:O1,"<"&A1:O1)+(A2:O2<SMALL(A2:O2,5))*100,),0)),2)*1=ROW(A1:A99)), (ROW(A1:INDEX(A:A,MATCH(0,INDEX(COUNTIFS(A2:O2,SMALL(A2:O2,5),A1:O1,"<"&A1:O1)+(A2:O2<SMALL(A2:O2,5))*100,),0)))>0)*1)), MMULT((MID(A1:INDEX(A1:O1,MATCH(0,INDEX(COUNTIFS(A2:O2,SMALL(A2:O2,5),A1:O1,"<"&A1:O1)+(A2:O2<SMALL(A2:O2,5))*100,),0)),2,2)*1=ROW(A1:A99)) +(RIGHT(A1:INDEX(A1:O1,MATCH(0,INDEX(COUNTIFS(A2:O2,SMALL(A2:O2,5),A1:O1,"<"&A1:O1)+(A2:O2<SMALL(A2:O2,5))*100,),0)),2)*1=ROW(A1:A99)), (ROW(A1:INDEX(A:A,MATCH(0,INDEX(COUNTIFS(A2:O2,SMALL(A2:O2,5),A1:O1,"<"&A1:O1)+(A2:O2<SMALL(A2:O2,5))*100,),0)))>0)*1),0) （GobGob） 2015/02/10(火) 13:29
Mookさんのコードでは、セルに対する書き込みが皆無になっていますので、それをそのままお借りして以下のようなＵＤＦ仕立てにもできますね。 （２行のうちのどこかが変われば実行）
A5 : =MaxFrequencyVal(1:2)
Function MaxFrequencyVal(a As Excel.Range)
Dim sList As Object
Dim r As Range
Set sList = CreateObject("System.Collections.SortedList")
For Each r In a.Cells(1).Offset(1).Resize(1, ActiveSheet.UsedRange.Columns.Count)
If r.Value <> "" Then sList.Add r.Value - Application.Min(CDbl(Mid(r.Offset(-1).Value, 2, 2)), CDbl(Mid(r.Offset(-1).Value, 5, 2))) / 10 ^ 4 - Rnd() / 10 ^ 8, r.Offset(-1).Value
Next
Dim dList As Object
Set dList = CreateObject("Scripting.Dictionary")
Dim i As Long, k As Variant
For i = 0 To 4
For Each k In Array(Mid(sList.GetByIndex(i), 2, 2), Mid(sList.GetByIndex(i), 5, 2))
If dList.exists(k) Then dList(k) = dList(k) + 1 Else dList(k) = 1
Next
Next
sList.Clear
For Each k In dList.keys
sList.Add dList(k) + 10 ^ -3 - CDbl(k) / 10 ^ 4, k
Next
MaxFrequencyVal = Format(Int(sList.GetByIndex(dList.Count - 1)), "'00")
End Function
（β） 2015/02/10(火) 16:38
A B C D E F G H I J
1 組03-06 組03-13 組06-13 組03-15 組09-17 組06-09
2 3.6 4.9 9.7 12.8 25.6 25.6
3
4
5 03
6 03 03 06 03 06 06 13 13 15 09
7 3 3 2 1 2
◆作業列を設ける方法です
A6{=LEFT(RIGHT(SMALL(($A2:$F2&SUBSTITUTE(MID($A1:$F1,2,5),"-",))*1,MOD(COLUMN(A1)-1,5)+1),4-(COLUMN(A1)>5)*2),2)}
★この式は「配列数式」です。式を入力後、CtrlとShiftを押しながらEnterを押して式を確定させてください
★式が確定すれば、式の両端に、｛ ｝がつきます
★式を確定後、右にコピー
A7=IF(COUNTIF($A6:A6,A6)=1,COUNTIF($A1:$F1,"*"&A6&"*"),"") ★右にコピー
A5{=TEXT(MIN((A7:J7<>MAX(A7:J7))*100+A6:J6),"00")}
★この式は「配列数式」です。式を入力後、CtrlとShiftを押しながらEnterを押して式を確定させてください
★式が確定すれば、式の両端に、｛ ｝がつきます
（maron） 2015/02/10(火) 18:21
・私の投稿２回目の「複」「外」は反映いただいているのでしょうか？
・βさんの最後のマクロは「A5 : =MaxFrequencyVal(1:2) 」以下を標準モジュールに
コピペすればいいのでしょうか？
（yoota） 2015/02/10(火) 18:41
◆作業列無ならば、
{=RIGHT(MIN((10-COUNTIF(A1:F1,"*"&LEFT(RIGHT(SMALL((A2:F2&SUBSTITUTE(MID(A1:F1,2,5),"-",))*1,MOD(COLUMN(A:J)-1,5)+1),4-(COLUMN(A:J)>5)*2),2)&"*"))*100
+LEFT(RIGHT(SMALL((A2:F2&SUBSTITUTE(MID(A1:F1,2,5),"-",))*1,MOD(COLUMN(A:J)-1,5)+1),4-(COLUMN(A:J)>5)*2),2)),2)}
★この式は「配列数式」です。式を入力後、CtrlとShiftを押しながらEnterを押して式を確定させてください ★式が確定すれば、式の両端に、｛ ｝がつきます
（maron） 2015/02/10(火) 18:46
少なくとも、βのコードとしてアップしたものには、「複」「外」は反映していません。 また、「最後のマクロ」とは、（β） 2015/02/10(火) 16:38 の投稿のマクロだと思いますが、 この中身は Mookさんの（Mook） 2015/02/10(火) 13:06 投稿のコードです。 これにも、「複」「外」は未反映ですけど。
Function MaxFrequencyVal(a As Excel.Range) から End Function までを標準モジュールに貼り付けてください。
で、A5 に =MaxFrequencyVal(1:2) といれてみてください。
（β） 2015/02/10(火) 20:01
今回の内容をきちんと考えると、 ・データ範囲はどう指定するのか、 ・指定範囲内にあるデータが >「漢字1文字+数字－数字」の「組み」があります > （数字は「半角二桁」です） の形でなかったらどうするのか ・1行目だけのデータ、2行目だけのデータ があったらどうするのか ・2行目が数値でなかったらどうするのか
など、ちょっと考えただけでもこれらに対応するエラー処理をした結果が、 「外」となるので、エラー処理だけで先に提示したコードの数倍になります。
先に提示したコードはデータに間違いがない前提、「複」は考慮しない前提なので それが必須の場合は、別の方の回答を参考にしてください。
数式で IFERROR を使うか、EXCEL が出すエラー表示をそのまま利用したほうが、 結果としてシンプルかもしれません。 （Mook） 2015/02/10(火) 20:43
データ側に不整合があって、通常なら実行時エラーで倒れるケース、UDF仕立ての場合は、好都合（？？）にも Functionからの戻りがエラー値（#VALUE!)になり、実行時エラーにはなりませんので、横着に（？）あくまで データは、正常に記載されているということを前提にしてもよろしいかと思います。
WorksheetFunction.関数 が通常マクロなら、UDFは Application.関数 のような感じですね。
（β） 2015/02/10(火) 21:18
ＵＤＦにおける「外」と「複」について。
「外」のうち、エラーは↑でコメントしたように #VALUE! が返りますので判断できますね。 無限ループに落ちれば（今回のケースではおそらくないと思われますが。あればバグということでコード修正でしょうね） そもそも、制御がループ内からでてきませんので「外」という文字をセットすること自体が不可能です。
（β） 2015/02/10(火) 21:31
maronさんのCOUNTIF案だとスッキリしますなぁ。 パクらせていただいて・・・ｗ
=0&MATCH(MAX(INDEX(COUNTIF(A1:INDEX(A1:G1,MATCH(MAX(INDEX(COUNTIF(A1:G1,">"&A1:G1)*(A2:G2=SMALL(A2:G2,5)),)),INDEX(COUNTIF(A1:G1,">"&A1:G1)*(A2:G2=SMALL(A2:G2,5)),),)),"*"&RIGHT(0&ROW($1:$99),2)&"*"),)), INDEX(COUNTIF(A1:INDEX(A1:G1,MATCH(MAX(INDEX(COUNTIF(A1:G1,">"&A1:G1)*(A2:G2=SMALL(A2:G2,5)),)),INDEX(COUNTIF(A1:G1,">"&A1:G1)*(A2:G2=SMALL(A2:G2,5)),),)),"*"&RIGHT(0&ROW($1:$99),2)&"*"),),)
=IF(ISNA(MODE(LARGE(INDEX(COUNTIF(A1:INDEX(A1:G1,MATCH(MAX(INDEX(COUNTIF(A1:G1,">"&A1:G1)*(A2:G2=SMALL(A2:G2,5)),)),INDEX(COUNTIF(A1:G1,">"&A1:G1)*(A2:G2=SMALL(A2:G2,5)),),)),"*"&RIGHT(0&ROW($1:$99),2)&"*"),),{1,2}))),"","複")
※ 組aa-bb 。。。 必ず aa<bb のこと。 （GobGob） 2015/02/11(水) 08:17 ⇒ 9:45 「複」追加
「複」対応のＵＤＦ版。βが最初にアップした自前コードの作業域使用部分を変更。 A5 には 「複」という文字表示ではなく、複数の数字を列挙。（03 06 等。ただし順番は1行目にあらわれる順番）
A5 : =GetMostValu(1:2)
標準モジュールに
Function GetMostValue(r As Range) As Variant
Dim f As Long
Dim t As Long
Dim n As Long
Dim z As Long
Dim a As String
Dim b As Long
Dim x As Long
Dim j As Long
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim w As Variant
Dim dic As Object
Dim d As Variant
Dim maxNum As Long
s1 = "MATCH(SMALL(A%:$%,5),A%:$%)"
s2 = "COUNTIF(A%:$%,SMALL(A%:$%,5))"
b = r.Row + 1 '２行目の行番号
z = Cells(r.Row, Columns.Count).End(xlToLeft).Column 'データ最終列
a = Split(Cells(1, z).Address, "$")(1) 'その列記号
s1 = Replace(s1, "$", a) '式の中の終了列記号を変換
s2 = Replace(s2, "$", a)
s1 = Replace(s1, "%", b) '式の中の行番号を変換
s2 = Replace(s2, "%", b)
t = Evaluate(s1) '５位の最後の数の列
n = Evaluate(s2) '５位の数字の個数
f = t - n + 1 '５位の最初の数の列
'処理対象最終列を求める
For j = f To t
If x = 0 Then
x = j
s3 = Cells(1, j).Value
Else
If Cells(1, j).Value < s3 Then
x = j
s3 = Cells(1, j).Value
End If
End If
Next
w = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1").Resize(, x).Value)))
w = Replace(w, "組", "")
w = Replace(w, "-", " ")
w = Split(w)
Set dic = CreateObject("Scripting.Dictionary")
For Each d In w
dic(d) = dic(d) + 1
If dic(d) > maxNum Then maxNum = dic(d)
Next
For Each d In w
If dic(d) <> maxNum Then dic.Remove d
Next
GetMostValue = Join(dic.Key)
End Function （β） 2015/02/11(水) 09:00
>データ範囲はどう指定するのか、
→実データは、「組」が１５３列（固定）、提示の２行をワンセットで
最大３６セット（可変）あります。
みなさんのご回答をみてすごく大変なことなんだと今は実感してますが、
当初はA5セルの式を必要分コピペすればいい．．程度に考えてました。
認識があま過ぎましたが、先ずは２行分を確認後に自身で応用できなかった
ときは再質問させていただきたく．．．
> 先に提示したコードはデータに間違いがない前提、．．．
→承知いたしました。 「外」は不要とさせてください。
提示したルールでは対処できない場合を意識しましたが、それを含め
「エラー」とわかればいいです。
>組aa-bb 。。。 必ず aa<bb のこと →aa,bbはランダムです。（ただし、aa=bb はありません）
いただいたご回答を理解するのはどれもハードルが高く、知らないことを
調べつつになりますので、時間経ってからいろいろお尋ねすると思います。
どうかよろしくお願いします。
（yoota） 2015/02/11(水) 10:04
（訂正）
実データは１５３列ではなく、１０列程度になります。
（作業列に昇順ソート抽出しますので）
＞ 「より小さい数値で出現する数字を含む組み」を選択する．．に訂正させていただきます。
私には正確に理解できないなぁ。
「より小さい数字を含む組み」ではないんですね？
「出現」を入れたことによって、何か解釈が変わるんでしょうか？
こうだったら正解はなんですか？（私は02と78だと思うんですけど。それぞれ、BDG,ACD）
行 ___A___ ___B___ ___C___ ___D___ ___E___ ___F___ ___G___ 1 組78-06 組02-13 組88-78 組02-78 組09-02 組09-05 組02-08 2 3.6 4.9 9.7 12.8 25.6 25.6 25.6
あと、2行目のデータは、小数点以下第1位までなんでしょうか・・・、
（半平太） 2015/02/13(金) 10:55
半平太さんの↑のパターンを検証しましたら、（β） 2015/02/11(水) 09:00 の説明とコードに間違いがあることが判明。 まず、A5 : =GetMostValu(1:2) 、スペルミスです。正しくは A5 : =GetMostValue(1:2)
それと、コードも。 最後の、GetMostValue = Join(dic.Key) アップ時になぜか勘違いして、ここを掲示板上で書き直してしまったようです。 ただしくは、
w = dic.keys
If IsArray(w) Then w = Join(w)
GetMostValue = w
ところで、半平太さんの例で実行しますと、私のコードが返す値は、単体の 02 です。 どの列までを処理対象にするかということで、私のコードでは、同率五位の 25.6のうち 1行目の 組09-02 組09-05 組02-08 の比較で小さいものとして 組02-08。 なので、A列からG列までが範囲で、３回出現する78より4回出現する02をとっています。
このあたりも、ちょっとわかりにくいですね。
（β） 2015/02/13(金) 13:22
＞「・・より小さい数値で出現する数字を含む組み」
これが 「・・より小さい数値で出現する数字を含む組みまで」だったら、同解釈になるんですけども。
ムードとしては、5位が幾つもあった場合、その中の1個しか考えないのではないか、と感じています。 考慮すべきギリギリの順位にいる者(馬？)達が幅を利かせる結果は、目的にそぐわないのではないか・・・
まぁ、回答者同士の話し合いで決まるものでもないので、質問者のレス待ちですね。
（半平太） 2015/02/13(金) 13:51
Mookさん、Maronさん、GobGobさんの最新のご回答は何れも「03」になりますよね？
混乱させたこと、お許しください。
βさん、ご提案どおり「03」「06」と表示されます。
「複」よりもこちらの方が“スマート”ですね。 こちらで構いません。
半平太さん、拙い説明で申訳ないことです。
ご提示の例では「02」が正解となります。
βさんの結果はＯＫですが、ご説明にあります、
> 1行目の 組09-02 組09-05 組02-08 の比較で小さいものとして 組02-08。
この「小さい」はちょっとこちらの思いと異なるようですので、補足します。
・対象範囲は、昇順の５番目までです ※同値の数が不明なのでデータは10列分用意しています
・５番目が同値の場合は、対象の「組数字」の内、４番目までのそれらを含む組合せで２行目の数値がより小さいのを選択します
例では、（09,02,05,08）の内、「02」を含む「組02-13」の「4.9」が最も小さいので「02」を選択します。
>2行目のデータは、小数点以下第1位までなんでしょうか →第４位までです
昨夜から“熱発”でさらにレス遅くなりそうですが、よろしくお願いします。
（yoota） 2015/02/13(金) 19:47
・５番目が同値の場合は、対象の「組数字」の内、４番目までのそれらを含む組合せで２行目の数値がより小さいのを選択します 例では、（09,02,05,08）の内、「02」を含む「組02-13」の「4.9」が最も小さいので「02」を選択します。
これは・・・・・う～ん・・・・ 後だしじゃんけんというレベルじゃないですねぇ・・・
判定する最後尾の列を策定して（これがどこかが、わからなかったのですが、いずれにしても判定する最後尾の列） Ａ列からその列までの 組●-○ のなかで【一番たくさん出現する数】を求めようとしていました。 そういう説明でしたから。
でも・・・五位の列群の●や○を持つ、Ａ列からその最後尾の列の前の列までで、２行目の数が一番小さなもの？？ こういう説明って、どこかにありましたっけ？ 一番たくさん出現する数というのは、もう、どこかにとんでいって、判定条件ではなくなった？
もうしばらく静観します・・・・・
（β） 2015/02/13(金) 21:59
＞・５番目が同値の場合は、対象の「組数字」の内、４番目までのそれらを含む組合せで２行目の数値がより小さいのを選択します ＞例では、（09,02,05,08）の内、「02」を含む「組02-13」の「4.9」が最も小さいので「02」を選択します。
ふーん、それが「出現」と云う表現が使われた真相ですか。。 誰も分かってなかったんじゃないかなぁ。
と私はもう分かった風に書きましたけど、実はまだ分かっていません。 結局、条件次第では5位の組は何個でも考慮しなければならないこともあるって訳ですか？ そんな事さえ、未だ確信できない。
5位に限ってもまだ分からないのに、そのあと、4位が3人以上とか、3位が4人以上とかの ケースも考えなきゃならないとなると、ボケ気味の頭ではついて行けないなぁ。
しばらく静観します
（半平太） 2015/02/13(金) 23:11
の中で、「より小さい“数値”で出現する“数字”を含む組み」が説明になってなかったと思います。
組で使う“数字”（βさんの●〇）とその対の数字（２行目）を区別するのに敢えて“数値”と
使い分けたつもりでしたが、説明になってなかったんですね。
>Ａ列からその列までの 組●-○ のなかで【一番たくさん出現する数】を求めようと．．
→２行目の昇順５番目までを対象であれば、正しいです
>4位が3人以上とか、3位が4人以上とかのケースも考えなきゃならないとなると、．．
→「△位」ではなく、「△番目」なんです。
あくまでも昇順（左から）５番目までを対象範囲にしたいのです。
昇順１位が３個２位が２個であれば、この５個が対象になります。
この５番目が同値の場合だけやっかいかなとは思っていますが。
この５番目に同値があると、
・範囲が特定できない ・４番目までの数値（２行目）まで遡る必要が生じる．．
で、やはりムズですかね。
まだ説明になってないでしょうか？
（yoota） 2015/02/13(金) 23:55
数字とか数値とか、区別が紛らわしいので、、
『投手と捕手の背番号(順不同)の組合せで、
防除率(2行目)の良い方から5番目までの組だけを対象に、
一番多い背番号を抽出したい』
と云う想定で考えてみます。
(1)防御率が同じ組が5位に2組以上ある場合、 そこから1組だけピックアップするロジックが必要になります。
(2)防御率が同じ組が4位に3組以上ある場合、 そこから2組だけピックアップするロジックが必要になります。
：
(5)防御率が同じ組が1位に6組以上ある場合
そこから5組をピックアップするロジックが必要になります。
「遡りのルール」で、6番目を確実に足切できるでしょうか？
上記(5)なんて、遡るベキ上位組がありません。 それ以外でも、上記(2)の具体例が下図ですが、 BT-4、5、6 の中でどのバッテリーが残れるんですか？（その理由は？）
<防御率が同じ組が、4位に3バッテリーある場合> 行 ______A______ ___B___ ___C___ ___D___ ___E___ ___F___ ___G___ ___H___ 1 背番号組合せ 組01-02 組02-01 組03-04 組05-02 組06-01 組09-02 組70-80 2 防御率 10 11 12 13 13 13 20 3 バッテリー名 BT-1 BT-2 BT-3 BT-4 BT-5 BT-6 BT-7
※前レスで防御率の小数点以下の桁をお尋ねしましたが(4桁との事でした）、 整数部分の最大桁数についても限定できますか？
（半平太） 2015/02/14(土) 08:15
(2)の場合、３つ共残れます。「01」「02」が何れもBT-1に含まれますから。
(5)の場合、5番目までの「組」でより多く出現する番号が該当します。（敢えてそうします）
尚、組01-02 組02-01 は同じ扱いです。 （番号が振られているのは同じ属性？なので）
あるペア同志でアウトプット（成果）の悪い（良い）順に5番目までを見て、
“何回も顔を出しとるコイツが足を引っ張とる（貢献してる）んかいな”．．みたいなことをしたいのです。
注）実際はこんな意地悪な用途ではありませんし、人以外に馬や船？にも使えそうです(笑)
整数部分も4桁までを想定しています。
（yoota） 2015/02/14(土) 10:16
うーん、なんか新しい考え方が次々に出てくるようで(勿論、私にとってと云う意味ですけど）、 私の頭の出来ではついていけませんので、この際、キッパリと退散いたします。 m(__)m
（半平太） 2015/02/14(土) 15:17
先の(5)の場合を含め5番目が同値の場合に何個までなのかが不明ではどうしようもないですよね？
そこで、下記のようにルールを変更してもやはりムリがあるでしょうか？
（ルール）
・昇順に並べた組の5個目までに出現した組番号の中で最も多く出現した番号を選択する
・5個目に同値の組がある場合は、該当する組番号の中で最も小さい順位で出現したことがある
番号を含む組を選ぶ
・5個目に同値の組があった場合、処理対象は最大8個までとする
どうでしょうか？
（yoota） 2015/02/15(日) 00:01
なぜ範囲のルールがわかりにくいかというと、たとえば半平太さんはバッテリーと防御率という 具体的なものをあげられたけど、(yoota)さんからは、この処理が具体的に何を相手にどんなことを したいのかということが、全く説明なく、これはちいさいのがいいとか、たくさんがいいとか こちらとしては、なぜ小さいのがいいのか、なぜたくさんがいいのか、そういうことが、あぁ、なるほどと 思えず、ただ (yoota)さんがそういうからそうなんだと、、でもたくさんとは、何がたくさんなのか、ちいさいとは なにがちいさいのか それが不明なので勝手な解釈をする。 で、こういう解釈でいいですかと、一生懸命、(yoota)さんに理解してもらおうとする。 本末転倒でちょっと疲れ気味。
以下は、「ある解釈」で書いたけど、もう、「こういう解釈です」という説明はこちらはしない。 もし、結果オーライなら使えばいいし、ＮＧなら捨ててください。
Function GetMostValue(r As Range) As Variant
Dim f As Long
Dim t As Long
Dim n As Long
Dim z As Long
Dim a As String
Dim b As Long
Dim x As Long
Dim j As Long
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim w As Variant
Dim c As Range
Dim dic As Object
Dim d As Variant
Dim maxNum As Long
Dim stage As Object
Dim pair As Object
Dim sv As Long
Set stage = CreateObject("Scripting.Dictionary")
Set pair = CreateObject("Scripting.Dictionary")
For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft))
w = c.Value
w = Replace(w, "組", "")
w = Replace(w, "-", " ")
w = Split(w)
w(0) = CLng(w(0))
w(1) = CLng(w(1))
If Not stage.exists(w(0)) Then stage(Val(w(0))) = c.Column
If Not stage.exists(w(1)) Then stage(Val(w(1))) = c.Column
pair(c.Column) = w
Next
s1 = "MATCH(SMALL(A%:$%,5),A%:$%)"
s2 = "COUNTIF(A%:$%,SMALL(A%:$%,5))"
b = r.Row + 1 '２行目の行番号
z = Cells(r.Row, Columns.Count).End(xlToLeft).Column 'データ最終列
a = Split(Cells(1, z).Address, "$")(1) 'その列記号
s1 = Replace(s1, "$", a) '式の中の終了列記号を変換
s2 = Replace(s2, "$", a)
s1 = Replace(s1, "%", b) '式の中の行番号を変換
s2 = Replace(s2, "%", b)
t = Evaluate(s1) '５位の最後の数の列
n = Evaluate(s2) '５位の数字の個数
f = t - n + 1 '５位の最初の数の列
If t > 8 Then t = 8 '最大8
If t < f Then t = f '不要かもしれないけど頭がはたらかないので
'処理対象最終列を求める
For j = f To t
If x = 0 Then
x = j
sv = WorksheetFunction.Min(stage(pair(j)(0)), stage(pair(j)(1)))
Else
If WorksheetFunction.Min(stage(pair(j)(0)), stage(pair(j)(1))) < sv Then
x = j
sv = WorksheetFunction.Min(stage(pair(j)(0)), stage(pair(j)(1)))
End If
End If
Next
If x = 1 Then
w = Range("A1").Value
Else
w = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(Range("A1").Resize(, x).Value)))
End If
w = Replace(w, "組", "")
w = Replace(w, "-", " ")
w = Split(w)
Set dic = CreateObject("Scripting.Dictionary")
For Each d In w
dic(d) = dic(d) + 1
If dic(d) > maxNum Then maxNum = dic(d)
Next
For Each d In w
If dic(d) <> maxNum Then dic.Remove d
Next
w = Join(dic.keys)
GetMostValue = w 'Join(dic.Key)
End Function
（β） 2015/02/15(日) 07:53
“ある解釈”が私にはコードを拝見してもわかりませんが、この結果は求めるものではありません。
「組30-06」に置換した場合は、「06」が求めるものになります。
（5番目までが、「03」は2個、「06」は3個、「13」は2個なので）
あるペア（バッテリー）－成果（防御率）の一覧を見て、左から5番目までで最も名前（番号）が
多く出てくるのを求めたい、というのが根本です。
ただ、5番目の前後に同値があった場合の処理が私自身整理できていないため、
うまく説明できていないのだと思います。
先述の「最大8個」もわからない表現になっていますね。
同値が続いて仮に左から10個までになっても「8個まで」で処理するという意味なんですが．．．
また、5番目前後に同値があった場合に、より左で出ていたことがある名前（番号）を
含むペアをピックアップするのは、単に私自身が“合理的”と思っただけで．．．
これもわかりづらいですね。
これ以上拙い質問でみなさんの貴重なお時間を割いてもらうわけにはいきませんので、
これで一旦“幕引き”で構いません。
これからは、もっと理解いただけるように表現力を磨きたいと思います。
もちろん、ご回答いただいた式やマクロとは今も“格闘中”で、不明点は機会があれば
別途質問をさせていただきたいと思います。
みなさん、その時はよろしくお願いいたします。 本当にありがとうございました。
（yoota） 2015/02/15(日) 22:09
yootaさんも冷静ですね ＾＾
他に面白そうなトピックもないので、もう一度考えてみました。
＞ただ、5番目の前後に同値があった場合の処理が私自身整理できていない これは表現できてはいないが、頭の中ではいつも同じ解が出せる自信はある、 と云う理解でいいですね。そうじゃないと、回答側としては解ける訳もないです。
・・で、頭の整理をする目的では5番目までのピックアップはちょっと多いので、 仮に3番目までピックアップする問題だと仮定して考えてみます。
以下は、3番目の同値が3バッテリあるケースです。
私の理解はI列に書きましたが、yootaさんの考え方と同じですか？
行 ___A___ ___B___ ___C___ ___D___ ___E___ ___F___ ___G___ _H_ ______ I ______ 1 ケース1 背番号 組01-02 組03-04 組05-06 組07-08 組07-09 該当列 2 防御率 1.5 2.5 3.5 3.5 3.5 1,2,3,4,5 (遡りできるものはないが、落伍させられるものもない） 3 該当 1 1 1 1 1 最多→07 4 5 6 ケース2 背番号 組01-02 組03-04 組05-06 組03-08 組01-09 該当列 7 防御率 1.5 2.5 3.5 3.5 3.5 1,2,5 8 該当 1 1 0 0 1 最多→01 9 10 11 ケース3 背番号 組01-02 組03-04 組05-06 組03-08 組04-09 該当列 12 防御率 1.5 2.5 3.5 3.5 3.5 1,2,4,5 13 該当 1 1 0 1 1 最多→03,04 14 15 16 ケース4 背番号 組01-02 組03-04 組03-06 組01-06 組02-06 該当列 17 防御率 1.5 2.5 3.5 3.5 3.5 1,2,4,5 18 該当 1 1 0 1 1 最多→01,02,06 19 20
>yootaさんも冷静ですね ＾＾
→おそらく“鈍感”という意味だと思いますが、意外とアルコールが入っている時は
わりとアタマ冴えてます（今のように業務中はまわってませんが）＾＾
さて、ご提示はズバリ私の考えと一致しています！
このように理路整然と質問アップできていたら．．と悔やまれてなりません。
ただ、この提示を拝見してて、ケース４の「06」のように
“回数が同じでも最後に出てきたのをピックアップしてていいのか？”
という当初想定外のケースが悩ましいですが、キリがないので良しとします。
よろしくお願いします．．．でいいのでしょうか？
（yoota） 2015/02/17(火) 09:43
＞半平太さん？ 署名するのを失念しました。（当初あったのですが、微修正したとき署名を書換え対象に含めてしまいました）
＞おそらく“鈍感”という意味だと思いますが、 それはないです。もう一度考えてみようと思わせる内容です。
＞ただ、この提示を拝見してて、ケース４の「06」のように ＞“回数が同じでも最後に出てきたのをピックアップしてていいのか？” ＞という当初想定外のケースが悩ましいですが、キリがないので良しとします。 ↑ これに関しては、当初から懸念材料で、こんな風に書いたのですけど。 ↓ ＞ ムードとしては、5位が幾つもあった場合、その中の1個しか考えないのではないか、と感じています。 ＞ 考慮すべきギリギリの順位にいる者(馬？)達が幅を利かせる結果は、目的にそぐわないのではないか・・・
下記コードを標準モジュールに貼り付た後、
目的のセルに =DeckeMost(セル範囲、条件順位) の形で入力してみてください。 例：A5セル =DeckeMost(A1:F3,5)
< 結果図> 行 ___A___ ___B___ ___C___ ___D___ ___E___ ___F___ 1 組03-06 組03-13 組06-13 組03-15 組09-17 組06-09 2 3.6 4.9 9.7 12.8 25.6 25.6 3 4 5 3個⇒ 03 06
'貼り付けるコード
Private Type myType
myBTcomb As Variant
myBattery1 As Variant
myBattery2 As Variant
myRank As Long
myRatio As Double
priority As Variant
End Type
Public Function DeckeMost(batteries As Range, numOfChoice)
Dim NN As Long, Rank As Long, ratioSofar As Double
Dim alldata() As myType
Dim lastRank As Long
Dim potentialEdge As Long
Dim potentialMemberPriority() As Variant
Dim limitEntitled As Long
Dim Deckes(1 To 99) As Long
Dim maxNum As Long
Dim msg As String
ReDim alldata(1 To batteries.Columns.Count)
Set batteries = batteries.Rows(1).Cells
If Application.countif(batteries, "組??-??") = 0 Then
DeckeMost = "組00-00のある行を指定してください"
Exit Function
ElseIf numOfChoice > 9 Then
DeckeMost = "抽出順位は9以下を指定してください"
Exit Function
End If
numOfChoice = Application.Min(batteries.Columns.Count, numOfChoice)
potentialEdge = UBound(alldata)
Rank = 1
ratioSofar = batteries.Cells(1, 1).Offset(1, 0).Value
For NN = 1 To UBound(alldata) 'AllDataに諸データセット
alldata(NN).myBTcomb = batteries.Cells(1, NN).Value
alldata(NN).myBattery1 = Mid(alldata(NN).myBTcomb, 2, 2)
alldata(NN).myBattery2 = Mid(alldata(NN).myBTcomb, 5, 2)
alldata(NN).myRatio = batteries.Cells(1, NN).Offset(1, 0).Value
If ratioSofar < alldata(NN).myRatio Then
Rank = NN
ratioSofar = alldata(NN).myRatio
End If
alldata(NN).myRank = Rank
If Rank > numOfChoice Then
potentialEdge = NN - 1 '有効候補最終列番
Exit For
End If
Next
lastRank = alldata(potentialEdge).myRank '有効最終ランク
Rem 個数の絞り込み
ReDim potentialMemberPriority(1 To potentialEdge)
If potentialEdge > numOfChoice Then '最下位ランクに同値がある場合
Call retroactiveProc(alldata, potentialEdge, lastRank)
For NN = 1 To potentialEdge 'Priorityを数値化後、配列に格納
If alldata(NN).myRank <= lastRank Then
potentialMemberPriority(NN) = CLng(alldata(NN).priority)
End If
Next
limitEntitled = Application.Small(potentialMemberPriority, lastRank) 'priority足切基準
Else
limitEntitled = 100
End If
For NN = 1 To potentialEdge '背番号別に集計
If alldata(NN).priority <= limitEntitled Then
Deckes(alldata(NN).myBattery1) = Deckes(alldata(NN).myBattery1) + 1
Deckes(alldata(NN).myBattery2) = Deckes(alldata(NN).myBattery2) + 1
End If
Next
maxNum = Application.Max(Deckes) '同背番号の最大個数
For NN = 1 To 99
If Deckes(NN) = maxNum Then
msg = msg & " " & Format(NN, "00")
End If
Next NN
DeckeMost = maxNum & "個⇒" & msg
End Function
Private Sub retroactiveProc(ByRef alldata() As myType, potentialEdge, lastRank) '遡り
Dim NN, MM
For NN = potentialEdge To 2 Step -1 '同値データの上位組検索(あったら順にPriorityに記録)
For MM = 1 To potentialEdge - 1
If alldata(MM).myRank < lastRank And alldata(NN).myRank = lastRank Then
If InStr(alldata(NN).myBTcomb, alldata(MM).myBattery1) Or _
InStr(alldata(NN).myBTcomb, alldata(MM).myBattery2) Then
alldata(NN).priority = _
alldata(NN).priority & alldata(MM).myRank
Else
alldata(NN).priority = alldata(NN).priority & "9" '上位が無い場合
End If
End If
Next MM
If Not IsEmpty(alldata(NN).priority) Then
alldata(NN).priority = reAlignment(alldata(NN).priority)
End If
Next NN
End Sub
Private Function reAlignment(priority)
Dim KK As Long
Dim box()
Dim box2()
ReDim box(1 To Len(priority))
ReDim box2(1 To Len(priority))
For KK = 1 To Len(priority)
box(KK) = CLng(Mid(priority, KK, 1))
Next KK
For KK = 1 To Len(priority)
box2(KK) = Application.Small(box, KK)
Next KK
reAlignment = Join(box2, "")
End Function
（半平太） 2015/02/17(火) 16:48 → 23:05(全面修正)
まだ確認途中ですが、取急ぎお礼いたしたく。
私のせいでずいぶんと長い投稿になってしまいましたが、
他の方のを含めご回答内容に関する質問はこのまま続けていって
いいものでしょうか？ 別にアップすべきでしょうか？
※今日は業務そっちのけで、maronさんやGobGobさんの式の理解に費やして
いたのですが、お手上げ状態で．．
MooKさんやβさんのマクロも敷居が高いですが、何か吸収したいと思っています。
よろしくお願いします。
（yoota） 2015/02/17(火) 18:48
済みません。間違えました。
遡った先の上位間でまた同値の状況になっている場合、 本コードでは、より左にある方に一致した組が優先的に扱われる形になっております。 正しくは、上位の順位が同じなら、その間に優劣はないようにしないといけなかったです。
ちょっと厄介なので、ゆっくり考えます。
＞※=DeckeMost(A1:F3,5)のF3はF2にしました あ、済みません。 実のところ、最上行(1行)だけ合っていれば、何行あっても結果は変わらない様に作ってあります。 テストで余分に選択した数式をそのままアップしてしまいました。
＞他の方のを含めご回答内容に関する質問はこのまま続けていって ＞ いいものでしょうか？ 別にアップすべきでしょうか？ 常識的には、このトピでやるのが普通なんですけど、長くなり過ぎで、 まだ見ているか分からないので、新しく立てた方がいいような気がします。
ここのトピックの引用の仕方は、他の事例を参照してください。
（半平太） 2015/02/17(火) 19:44
>遡った先の上位間でまた同値の状況になっている場合、本コードでは、 >より左にある方に一致した組が優先的に扱われる形になっております。 >正しくは、上位の順位が同じなら、その間に優劣はないようにしないといけなかったです
→う～ん、深いですね、お考えが。
なんかいろんなケースが“増殖”していきそうで自分でもオソロシイです(笑)
>長くなり過ぎで、まだ見ているか分からないので、新しく立てた方がいいような気がします。
→そうですね、そうさせていただきます。
（yoota） 2015/02/17(火) 22:34
他にもミスがあったので、前レス（2015/02/17(火) 16:48）のコードを全面上書き修正しました。
（半平太） 2015/02/17(火) 23:06
自己削除 m(__)m （半平太） 2015/02/18(水) 11:34
提示例で、２行目の数値を変えて試行した結果を示します。
１～６番目まで同値⇒「03」「06」が該当
２～６番目まで同値⇒「03」「06」が該当
３～６番目まで同値⇒「03」が該当
４～６番目まで同値⇒「03」が該当
５～６番目まで同値⇒「03」「06」が該当
これは
>遡った先の上位間でまた同値の状況になっている場合、本コードでは、 >より左にある方に一致した組が優先的に扱われる形になっております。
ともちょっと違うような気がするのですが。
ピントずれてたらすみません．．．
（yoota） 2015/02/20(金) 11:26
ロジックが込み入っているので、簡単にならないか見直していたのですけど、 もしかしたら、そちらサイドでもう仕様を変更しているかも知れないと思い、 検討を打ち切っておりました。
で、見直し後のコードが以下です。・・けど、やっぱり込み入ってしまった (^^ゞ
テスト結果は以下ですが、これでもそちらのイメージと違う場合は、
「ケースの何番が何になるべきなのに、何になっている」とか 「こんなデータにしてみたが、何になるべきなのに、何になってしまう」
と言う形でご指摘をお願いします。
<新Verでのテスト 結果図> 行 ___A___ ___B___ ___C___ ___D___ ___E___ ___F___ ___G___ _____H_____ 1 ケース TB-1 TB-2 TB-3 TB-4 TB-5 TB-6 結果 ----------------------------------------------------------------------- 2 1 組03-06 組03-13 組06-13 組03-15 組09-17 組06-09 3個⇒ 03 06 3 1 1 1 1 1 1 4 考慮 考慮 考慮 考慮 考慮 考慮 5 6 2 組03-06 組03-13 組06-14 組03-16 組09-18 組06-10 3個⇒ 03 06 7 1 2 2 2 2 2 8 考慮 考慮 考慮 考慮 -外- 考慮 9 10 3 組03-06 組03-13 組06-15 組03-17 組09-19 組06-11 3個⇒ 03 06 11 1 1 3 3 3 3 12 考慮 考慮 考慮 考慮 -外- 考慮 13 14 4 組03-06 組03-13 組06-16 組03-18 組09-20 組06-12 3個⇒ 03 06 15 1 2 3 3 3 3 16 考慮 考慮 考慮 考慮 -外- 考慮 17 18 5 組03-06 組03-13 組06-17 組03-19 組09-21 組06-13 3個⇒ 03 06 19 1 1 1 4 4 4 20 考慮 考慮 考慮 考慮 -外- 考慮 21 22 6 組03-06 組03-13 組06-18 組03-20 組09-22 組06-14 3個⇒ 03 06 23 1 2 2 4 4 4 24 考慮 考慮 考慮 考慮 -外- 考慮 25 26 7 組03-06 組03-13 組06-19 組03-21 組09-23 組06-15 3個⇒ 03 06 27 1 2 3 4 4 4 28 考慮 考慮 考慮 考慮 -外- 考慮 29 30 8 組03-06 組03-13 組06-20 組03-22 組09-24 組06-16 3個⇒ 03 06 31 1 1 1 1 5 5 32 考慮 考慮 考慮 考慮 -外- 考慮 33 34 9 組03-06 組03-13 組06-21 組03-23 組09-25 組06-17 3個⇒ 03 06 35 1 2 2 2 5 5 36 考慮 考慮 考慮 考慮 -外- 考慮 37 38 10 組03-06 組03-13 組06-22 組03-24 組09-26 組06-18 3個⇒ 03 06 39 1 2 3 3 5 5 40 考慮 考慮 考慮 考慮 -外- 考慮 41 42 11 組03-06 組03-13 組06-23 組03-25 組09-27 組06-19 3個⇒ 03 06 43 1 2 3 4 5 5 44 考慮 考慮 考慮 考慮 -外- 考慮 45 46 12 組03-06 組03-13 組06-24 組03-26 組03-28 組06-20 4個⇒ 03 47 1 2 3 4 5 5 48 考慮 考慮 考慮 考慮 考慮 -外- 49 50 13 組03-06 組03-13 組06-24 組03-26 組03-24 組06-13 4個⇒ 03 51 1 2 3 4 5 5 52 考慮 考慮 考慮 考慮 考慮 -外-
'貼り付けるコード↓
Private Type myBAT
myBTcomb As Variant
myDec1 As Variant
myDec2 As Variant
myRank As Long
myRatio As Double
priority As Variant
priorityHex As String
selected As Boolean
End Type
Public Function DeckeMost(batteries As Range, numOfChoice)
Dim NN As Long, MM As Long, Rank As Long, ratioSofar As Double
Dim alldata() As myBAT
Dim numOfCols As Long
Dim lastRank As Long
Dim Deckes(1 To 99) As Long
Dim maxNum As Long
Dim msg As String
numOfCols = batteries.Columns.Count
ReDim alldata(1 To numOfCols)
ReDim potentialMemberPriority(1 To numOfCols)
Set batteries = batteries.Rows(1).Cells
If Application.countif(batteries, "組??-??") = 0 Then
DeckeMost = "組00-00のある行を指定してください"
Exit Function
ElseIf numOfChoice > 9 Then
DeckeMost = "抽出順位は9以下を指定してください"
Exit Function
End If
numOfChoice = Application.Min(numOfCols, numOfChoice)
Rank = 1
lastRank = 1
ratioSofar = batteries.Cells(1, 1).Offset(1, 0).Value
For NN = 1 To numOfCols 'AllDataに各組の諸データセット
ReDim alldata(NN).priority(numOfCols)
alldata(NN).priority = Split(WorksheetFunction.Trim(Application.Rept("0 ", numOfCols + 1)))
alldata(NN).myBTcomb = batteries.Cells(1, NN).Value
alldata(NN).myDec1 = Mid(alldata(NN).myBTcomb, 2, 2)
alldata(NN).myDec2 = Mid(alldata(NN).myBTcomb, 5, 2)
alldata(NN).myRatio = batteries.Cells(1, NN).Offset(1, 0).Value
If ratioSofar < alldata(NN).myRatio Then
Rank = NN
ratioSofar = alldata(NN).myRatio
If Rank <= numOfChoice Then
lastRank = Rank
End If
End If
alldata(NN).myRank = Rank
alldata(NN).priority(0) = Hex(16 - Rank)
Next
Rem 他組に自番があれば、そのRankをpriorityにメモ
For NN = 1 To numOfCols
For MM = 1 To numOfCols
If MM <> NN Then
If alldata(NN).myRank > alldata(MM).myRank Then
If InStr(alldata(NN).myBTcomb, alldata(MM).myDec1) Or _
InStr(alldata(NN).myBTcomb, alldata(MM).myDec2) Then
alldata(NN).priority(MM) = alldata(NN).priority(MM) + 1
End If
End If
End If
Next MM
Next NN
Rem PriorityHex を作成する
For NN = 1 To numOfCols
alldata(NN).priorityHex = Join(alldata(NN).priority, "")
Next NN
Call mutualFinding(alldata, numOfCols, 0, numOfChoice)
For NN = 1 To numOfCols
If alldata(NN).selected Then
Deckes(alldata(NN).myDec1) = Deckes(alldata(NN).myDec1) + 1
Deckes(alldata(NN).myDec2) = Deckes(alldata(NN).myDec2) + 1
End If
Next
maxNum = Application.Max(Deckes) '同背番号の最大個数
For NN = 1 To 99
If Deckes(NN) = maxNum Then
msg = msg & " " & Format(NN, "00")
End If
Next NN
DeckeMost = maxNum & "個⇒" & msg
End Function
Private Sub mutualFinding(alldata() As myBAT, numOfCols, numSelected, numOfChoice)
Dim NN As Long
Dim maximum As String
For NN = 1 To numOfCols
If Not alldata(NN).selected Then
If StrComp(maximum, alldata(NN).priorityHex) = -1 Then
maximum = alldata(NN).priorityHex
End If
End If
Next NN
For NN = 1 To numOfCols
If alldata(NN).priorityHex = maximum Then
alldata(NN).selected = True
numSelected = numSelected + 1
End If
Next NN
If numSelected < numOfChoice Then
Call mutualFinding(alldata, numOfCols, numSelected, numOfChoice)
End If
End Sub
（半平太） 2015/02/20(金) 15:29
βさん、marronさん、GobGobさん、Mookさん
質問のしかたがなってなかったこと、重ねてお詫びします。
みなさん、ありがとうございました。
これからもよろしくお願いいたします。
（yoota） 2015/02/22(日) 08:28
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.