Results of 1 - 1 of about 1215 for （Mook）
(0.001 sec.)
- [[20150209183032]]
- #score: 9211
- @digest: 935ca5a7d3f39479f4e198d9739018a9
- @id: 67248
- @mdate: 2015-02-21T23:28:16Z
- @size: 57702
- @type: text/plain
- #keywords: 組03 (541083), alldata (361694), 組06 (356453), 慮考 (322427), 組09 (224720), batteries (121718), priority (113074), 組02 (108485), 個⇒ (108485), numofcols (102995), numofchoice (100153), 慮- (92987), deckemost (88570), mybtcomb (87217), 御率 (82313), yoota (81228), 五位 (74820), dlist (66871), 同値 (55516), 考慮 (27678), 出現 (16236), nn (12991), 番目 (11132), small (8824), 2015 (7586), replace (6086), ケー (4849), worksheetfunction (4290), function (3932), 火) (3734), countif (3515), variant (3499)
- 『条件抽出』（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) '5位の最後の数の列 n = Evaluate(s2) '5位の数字の個数 f = t - n + 1 '5位の最初の数の列 '処理対象最終列を求める 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 ---- ◆質問です 1）「組03-06」は、「03」1回、「06」1回でしょうか? 2）「組03-03」のケースはあるのでしょうか?・・この場合「03」2回になるのでしょうか? 3）ルールの「・第五位が同数値の場合（組09-17,組06-09）」の意味がわかりません （組09-17,組06-09）では、第二位と第五位が同数字の場合ではないでしょうか? （maron） 2015/02/10(火) 04:09 ---- To (maron)さん 私が答える立場ではないですが、アップしたコードを書くときの、自分なりの解釈として 「五位」とは、2行目の数値で昇順の五位。なので、25.6 なんだろうと。 で、2つある、それらのどちらなのかというと、組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 ---- ありゃりゃ。ぜんぜん駄目だわw 仕切りなおしますわ。 （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) '5位の最後の数の列 n = Evaluate(s2) '5位の数字の個数 f = t - n + 1 '5位の最初の数の列 '処理対象最終列を求める 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 ---- みなさま、貴重なお時間ありがとうございます。 せっかく回答いただいたのにレス遅くなって申訳ありません。 また、説明不足もお詫びします。 ほとんど（β）さんに回答いただきましたが、改めて回答します。 >1）「組03-06」は、「03」1回、「06」1回でしょうか? →ハイ、そうです。 >2）「組03-03」のケースはあるのでしょうか?・・この場合「03」2回になるのでしょうか? →同数字の組合せはありません。 >3）ルールの「・第五位が同数値の場合（組09-17,組06-09）」の意味がわかりません →「第五位」の文言が誤解を与えてしまいました。 昇順の「5番目」までの「組」を抽出の対象とし、5番目に同値のものがあれば 「より小さい数値で出現する数字を含む組み」を選択する..に訂正させていただきます。 また、該当が複数の場合、A5セルには「複」と表示するようにしていただけますか? 例えば、1番目に「組02-10」がある時、02と10が同回数で出現トップとか、5番目の同値の 複数組に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さんのコードでは、セルに対する書き込みが皆無になっていますので、それをそのままお借りして以下のようなUDF仕立てにもできますね。 （2行のうちのどこかが変われば実行） 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 ---- ありがとうございます。 今、みなさんのご回答を確認できる環境にない中、レベルの低い再質問お許しください。 ・私の投稿2回目の「複」「外」は反映いただいているのでしょうか? ・βさんの最後のマクロは「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 ---- ・私の投稿2回目の「複」「外」は反映いただいているのでしょうか? ・βさんの最後のマクロは「A5 : =MaxFrequencyVal(1:2) 」以下を標準モジュールに コピペすればいいのでしょうか? 少なくとも、βのコードとしてアップしたものには、「複」「外」は反映していません。 また、「最後のマクロ」とは、（β） 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 ---- UDFにおける「外」と「複」について。 「外」のうち、エラーは↑でコメントしたように #VALUE! が返りますので判断できますね。 無限ループに落ちれば（今回のケースではおそらくないと思われますが。あればバグということでコード修正でしょうね） そもそも、制御がループ内からでてきませんので「外」という文字をセットすること自体が不可能です。 （β） 2015/02/10(火) 21:31 ---- maronさんのCOUNTIF案だとスッキリしますなぁ。 パクらせていただいて・・・w =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 「複」追加 ---- 「複」対応のUDF版。βが最初にアップした自前コードの作業域使用部分を変更。 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 '2行目の行番号 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) '5位の最後の数の列 n = Evaluate(s2) '5位の数字の個数 f = t - n + 1 '5位の最初の数の列 '処理対象最終列を求める 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 ---- みなさんありがとうございます。 まとまった時間とれしだい確認させていただきます。（土日?） 取急ぎ、補足させていただきます。 >データ範囲はどう指定するのか、 →実データは、「組」が153列（固定）、提示の2行をワンセットで 最大36セット（可変）あります。 みなさんのご回答をみてすごく大変なことなんだと今は実感してますが、 当初はA5セルの式を必要分コピペすればいい..程度に考えてました。 認識があま過ぎましたが、先ずは2行分を確認後に自身で応用できなかった ときは再質問させていただきたく... > 先に提示したコードはデータに間違いがない前提、... →承知いたしました。 「外」は不要とさせてください。 提示したルールでは対処できない場合を意識しましたが、それを含め 「エラー」とわかればいいです。 >組aa-bb 。。。 必ず aa<bb のこと →aa,bbはランダムです。（ただし、aa=bb はありません） いただいたご回答を理解するのはどれもハードルが高く、知らないことを 調べつつになりますので、時間経ってからいろいろお尋ねすると思います。 どうかよろしくお願いします。 （yoota） 2015/02/11(水) 10:04 （訂正） 実データは153列ではなく、10列程度になります。 （作業列に昇順ソート抽出しますので） ---- ＞ 「より小さい数値で出現する数字を含む組み」を選択する..に訂正させていただきます。 私には正確に理解できないなぁ。 「より小さい数字を含む組み」ではないんですね? 「出現」を入れたことによって、何か解釈が変わるんでしょうか? こうだったら正解はなんですか?（私は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列までが範囲で、3回出現する78より4回出現する02をとっています。 このあたりも、ちょっとわかりにくいですね。 （β） 2015/02/13(金) 13:22 ---- ＞「・・より小さい数値で出現する数字を含む組み」 これが 「・・より小さい数値で出現する数字を含む組みまで」だったら、同解釈になるんですけども。 ムードとしては、5位が幾つもあった場合、その中の1個しか考えないのではないか、と感じています。 考慮すべきギリギリの順位にいる者(馬?)達が幅を利かせる結果は、目的にそぐわないのではないか・・・ まぁ、回答者同士の話し合いで決まるものでもないので、質問者のレス待ちですね。 （半平太） 2015/02/13(金) 13:51 ---- レス遅くなりすみません。 先ず最初にこちらの誤記を訂正させていただきます。 冒頭の、「例表の場合、A5セル=03 となります」 は間違いでした。 既にお気づきのように、03,06が同じ3回になります。 Mookさん、Maronさん、GobGobさんの最新のご回答は何れも「03」になりますよね? 混乱させたこと、お許しください。 βさん、ご提案どおり「03」「06」と表示されます。 「複」よりもこちらの方が“スマート”ですね。 こちらで構いません。 半平太さん、拙い説明で申訳ないことです。 ご提示の例では「02」が正解となります。 βさんの結果はOKですが、ご説明にあります、 > 1行目の 組09-02 組09-05 組02-08 の比較で小さいものとして 組02-08。 この「小さい」はちょっとこちらの思いと異なるようですので、補足します。 ・対象範囲は、昇順の5番目までです ※同値の数が不明なのでデータは10列分用意しています ・5番目が同値の場合は、対象の「組数字」の内、4番目までのそれらを含む組合せで2行目の数値がより小さいのを選択します 例では、（09,02,05,08）の内、「02」を含む「組02-13」の「4.9」が最も小さいので「02」を選択します。 >2行目のデータは、小数点以下第1位までなんでしょうか →第4位までです 昨夜から“熱発”でさらにレス遅くなりそうですが、よろしくお願いします。 （yoota） 2015/02/13(金) 19:47 ---- ・5番目が同値の場合は、対象の「組数字」の内、4番目までのそれらを含む組合せで2行目の数値がより小さいのを選択します 例では、（09,02,05,08）の内、「02」を含む「組02-13」の「4.9」が最も小さいので「02」を選択します。 これは・・・・・う～ん・・・・ 後だしじゃんけんというレベルじゃないですねぇ・・・ 判定する最後尾の列を策定して（これがどこかが、わからなかったのですが、いずれにしても判定する最後尾の列） A列からその列までの 組●-○ のなかで【一番たくさん出現する数】を求めようとしていました。 そういう説明でしたから。 でも・・・五位の列群の●や○を持つ、A列からその最後尾の列の前の列までで、2行目の数が一番小さなもの?? こういう説明って、どこかにありましたっけ? 一番たくさん出現する数というのは、もう、どこかにとんでいって、判定条件ではなくなった? もうしばらく静観します・・・・・ （β） 2015/02/13(金) 21:59 ---- ＞・5番目が同値の場合は、対象の「組数字」の内、4番目までのそれらを含む組合せで2行目の数値がより小さいのを選択します ＞例では、（09,02,05,08）の内、「02」を含む「組02-13」の「4.9」が最も小さいので「02」を選択します。 ふーん、それが「出現」と云う表現が使われた真相ですか。。 誰も分かってなかったんじゃないかなぁ。 と私はもう分かった風に書きましたけど、実はまだ分かっていません。 結局、条件次第では5位の組は何個でも考慮しなければならないこともあるって訳ですか? そんな事さえ、未だ確信できない。 5位に限ってもまだ分からないのに、そのあと、4位が3人以上とか、3位が4人以上とかの ケースも考えなきゃならないとなると、ボケ気味の頭ではついて行けないなぁ。 しばらく静観します （半平太） 2015/02/13(金) 23:11 ---- 説明不足...というより説明ベタですみません。 先に書きました文章、 「第五位」の文言が誤解を与えてしまいました。 昇順の「5番目」までの「組」を抽出の対象とし、5番目に同値のものがあれば 「より小さい数値で出現する数字を含む組み」を選択する..に訂正させていただきます の中で、「より小さい“数値”で出現する“数字”を含む組み」が説明になってなかったと思います。 組で使う“数字”（βさんの●〇）とその対の数字（2行目）を区別するのに敢えて“数値”と 使い分けたつもりでしたが、説明になってなかったんですね。 >A列からその列までの 組●-○ のなかで【一番たくさん出現する数】を求めようと.. →2行目の昇順5番目までを対象であれば、正しいです >4位が3人以上とか、3位が4人以上とかのケースも考えなきゃならないとなると、.. →「△位」ではなく、「△番目」なんです。 あくまでも昇順（左から）5番目までを対象範囲にしたいのです。 昇順1位が3個2位が2個であれば、この5個が対象になります。 この5番目が同値の場合だけやっかいかなとは思っていますが。 この5番目に同値があると、 ・範囲が特定できない ・4番目までの数値（2行目）まで遡る必要が生じる.. で、やはりムズですかね。 まだ説明になってないでしょうか? （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)(5)のようなケースを 避ける意味でした。（いろいろな想定が面倒?になってもいましたが..） (2)の場合、3つ共残れます。「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)さんに理解してもらおうとする。 本末転倒でちょっと疲れ気味。 以下は、「ある解釈」で書いたけど、もう、「こういう解釈です」という説明はこちらはしない。 もし、結果オーライなら使えばいいし、NGなら捨ててください。 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 '2行目の行番号 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) '5位の最後の数の列 n = Evaluate(s2) '5位の数字の個数 f = t - n + 1 '5位の最初の数の列 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 ---- βさん、上記のUDF?では「03」になりますよね? 因みに、最初の「組03-06」を「組30-06」に置換すると「06 03 13」になりますよね? “ある解釈”が私にはコードを拝見してもわかりませんが、この結果は求めるものではありません。 「組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さんも冷静ですね ^^ →おそらく“鈍感”という意味だと思いますが、意外とアルコールが入っている時は わりとアタマ冴えてます（今のように業務中はまわってませんが）^^ さて、ご提示はズバリ私の考えと一致しています! このように理路整然と質問アップできていたら..と悔やまれてなりません。 ただ、この提示を拝見してて、ケース4の「06」のように “回数が同じでも最後に出てきたのをピックアップしてていいのか?” という当初想定外のケースが悩ましいですが、キリがないので良しとします。 よろしくお願いします...でいいのでしょうか? （yoota） 2015/02/17(火) 09:43 ---- ＞半平太さん? 署名するのを失念しました。（当初あったのですが、微修正したとき署名を書換え対象に含めてしまいました） ＞おそらく“鈍感”という意味だと思いますが、 それはないです。もう一度考えてみようと思わせる内容です。 ＞ただ、この提示を拝見してて、ケース4の「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(全面修正) ---- 半平太さん、再考ありがとうございます。 提示例どおりの結果になりました! ※=DeckeMost(A1:F3,5)のF3はF2にしました “懸念”もとっくにお見通しだったんですね...気付きませんでした。 また、まるで私の“ブレ心”を見透かしたかのような応用がきく仕様ですね.. 嬉しい限りです。 まだ確認途中ですが、取急ぎお礼いたしたく。 私のせいでずいぶんと長い投稿になってしまいましたが、 他の方のを含めご回答内容に関する質問はこのまま続けていって いいものでしょうか? 別にアップすべきでしょうか? ※今日は業務そっちのけで、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 ---- マクロを理解できない(TT)ので確認させてください。 提示例で、2行目の数値を変えて試行した結果を示します。 1～6番目まで同値⇒「03」「06」が該当 2～6番目まで同値⇒「03」「06」が該当 3～6番目まで同値⇒「03」が該当 4～6番目まで同値⇒「03」が該当 5～6番目まで同値⇒「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... - https://www.excel.studio-kazu.jp/wiki/kazuwiki/201502/20150209183032.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97054 documents and 608268 words.
訪問者：