ここから質問投稿すると、最大4000ポイント当たる!!!! >>

またお世話になります。

例えば下記のようなデータがあるとします。

 |B|C|D|E|
----------------------
1|a|b|c|e|
----------------------
2|b|c|a|e|
----------------------
3|a|e|f|g|
----------------------
4|b|f|e|a|
----------------------
     :
     :
(データは下へ追加されていきます)


上記のデータを行毎に調べて、各値と最も多い組み合わせを調べるにはどうしたらよいでしょうか?
例えば「a」と最も多く組み合わせているのは、「e」となります。
あた「b」と多く組み合わせているのは、「e」となります。

このように各入力値ごとに、最も多く組み合わせているものを抽出するにはどのようにしたら良いでしょうか。
実際には文字ではなく数字を入力しています。

私が考えている方法は、すべての文字に対しての組み合わせ表を作成して、そこから最も多いそれぞれの組み合わせを求めるということですが、これではかなりの量の組み合わせデータを作成しなければならないことになります。

もっと簡単にできる方法はないかと思い、こちらに質問させて頂きました。


とても難しいような気がしますが、アドバイスをよろしく御願いします。


(エクセル98を使用しております。)

A 回答 (4件)

"組み合わせ"と考えると大変ですが、調べたい値、たとえば1なら、1を含む各行の中で、1の次に多くある値を調べればいいわけです。

なんだかNo.545271のご質問の応用編のようですね。

以下のマクロは、各行中に重複する値は無い事が前提です。1-2と2-1の扱いですが、両方表示します。データを新しいシートのA1にかかるようにコピーして使ってください。
ちょっと長いですが、もう眠いのでNo.545271の関数を少し変えて使いました。


Sub test3()
Dim c As Range, dc As Range, i As Integer, b As Byte, mc As Byte
Dim ip As Integer, nb As Byte, ia As Integer, ei As Integer
Dim myR As Range

Set dc = Range("A1").CurrentRegion
b = dc.Columns.Count
Columns(b + 2).Value = ""
For Each c In dc
If c.Value <> "" Then
i = 1
Do
With Cells(i, b + 2)
If .Value = "" And .Value <> c.Value Then
Cells(i, b + 2).Value = c.Value
ip = ip + 1
Exit Do
Else
If .Value = c.Value Then Exit Do
End If
End With
i = i + 1
Loop
End If
Next c
Set myR = dc.Offset(0, b + 4)
myR.Value = dc.Value
For ia = 1 To ip
ei = 0
For i = 1 To myR.Rows.Count
With myR.Rows(i)
For nb = 1 To b
If .Columns(nb).Value = Cells(ia, b + 2).Value Then
.Columns(nb).Value = ""
ei = ei + 1
mc = 1
Exit For
End If
Next nb
If mc = 0 Then .Value = ""
mc = 0
End With
Next i
If ei = 1 Then
Cells(ia, b + 3).Value = ""
Else
Cells(ia, b + 3).Value = InLarge2(myR, Cells(ia, b + 2).Text)
End If
myR.Value = dc.Value
Next ia
myR.Value = ""
Cells(1, b + 3).CurrentRegion.Sort Key1:=Cells(1, b + 3), Order1:=xlDescending, Header:=xlNo, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
End Sub

Function InLarge2(データ As Range, myS As String) As String
Dim moji() As String, Cosu() As Integer, i As Integer
Dim myRange As Range, Most As String, ip As Integer

ReDim moji(データ.Count)
ReDim Cosu(データ.Count)
For Each myRange In データ
If myRange.Text <> "" Then
Do
If moji(i) = myRange.Text Then
Cosu(i) = Cosu(i) + 1
Exit Do
Else
If moji(i) = "" Then
moji(i) = myRange.Text
Cosu(i) = 1
Exit Do
End If
i = i + 1
End If
Loop
i = 0
End If
Next myRange
i = 1
Do
If Cosu(ip) <= Cosu(i) Then
If Cosu(ip) = Cosu(i) Then
Most = Most & "," & moji(i)
Else
ip = i
Most = ""
End If
End If
i = i + 1
Loop Until Cosu(i - 1) = 0
InLarge2 = Cosu(ip) & "組 " & myS & "と" & moji(ip) & Most
End Function
    • good
    • 0

こんにちは。


難しいですね。
実際は数字でサンプルが文字と言うのもちょっと質問のされかたとしてはどうかと。。
直接回答とはいきませんが、参考になればと思います。

下記はタイトルを含まないデータがA列からD列に入っている想定で書いてます。
F列~G列にデータを出します。

テストではA1~D4に下記データだけを入れたシートを用意して行ないました。

A列 B列 C列 D列
a   b   c   e
b   c   a   e
a   e   f   g
b   f   e   a

必ずテスト環境で試して下さい。

Sub aa()
Const dRow = 6
Dim LRow As Long, pRow As Long, stCol As Integer
Dim mgCol As Integer, maxCol As Integer

LRow = Range("A65536").End(xlUp).Row
For i = 1 To LRow
  Rows(i).Sort key1:=Range("A" & i), Order1:=xlAscending, _
  Header:=xlNo, Orientation:=xlLeftToRight
Next i
Cells(1, dRow) = "データ"
pRow = 2: maxCol = 4
For i = 1 To LRow
 stCol = 1: mgCol = 2
 Do While stCol <= maxCol - 1
  Do While mgCol <= maxCol
   Cells(pRow, 6) = Cells(i, stCol) & Cells(i, mgCol)
    mgCol = mgCol + 1: pRow = pRow + 1
  Loop
  stCol = stCol + 1: mgCol = stCol + 1
 Loop
Next i
Columns(dRow).Sort key1:=Cells(1, dRow), Order1:=xlAscending, _
          Header:=xlYes, Orientation:=xlTopToBottom
Application.DisplayAlerts = False
Cells(1, dRow).CurrentRegion.Subtotal GroupBy:=1, _
     Function:=xlCount, TotalList:=Array(1), Replace:=True
Application.DisplayAlerts = True
Columns(dRow).EntireColumn.AutoFit
ActiveSheet.Outline.ShowLevels RowLevels:=2
End Sub
    • good
    • 0

#1の者です。


>(1)実際に試してみましたが、結果がセルに表示されませんでした。 ん~、難しいかな。。。
誤解されたようです。セルに本問の結果をセットする積もりでコーディングしてませんから。A1:D4にA,B,C,Dが入っているとして、画面にA-B,A-C,A-D,B-C,B-D,C-Dを表示するもので、1行の組み合わせはこれで良いですねと言う小手調べの、テスト的な部分的コーディグです。お望みのセルに結果を出すコーディングはもっとずっと行数が多くなります。
>(2)COUNTIF関数を使用していろいとと試しているのですが
全ての組み合わせを人間が拾い上げ、その組み合わせが
表中に何件あるかは関数で出せるでしょう。しかし七面倒
で私ならやる気がしません。
(3)本件はVBAでないと出来ないと思います。しかしVBAのコーディングを入れても、簡単でなくて、(1)のことからして、判っていただけるか心配です。
    • good
    • 0

データ入力列がB,C,D,Eの4列で終わりですか。


これは例示であって、実際ではもっと沢山列があるのですか。ご存知のように組み合わせの数は、要素が増えると直ぐ大きくなります。それで難しくなりそうです。
多分操作や関数では不可能でVBAが必要になるでしょう。コーディグを希望しますか。ロジックは
(1)各行について「各列の文(数)字の組み合わせ表(T)を作成して」
(2)既存の表(T)の中にその組み合わせがあるか探して
(3)あればその組み合わせの件数を+1し、
(4)最終行まで繰り返して
(5)件数列で降順にソートします。一番多い組み合わせは第1行目に出ます。
(6)うるさいのは(2)で、A-BもB-Aも同じと見なす必要があります。
各行の組み合わせは、第1行にA,B,C.Dが入っていてこの1行だけ組み合わせを見る例として
Sub test04()
i = 1
For k = 1 To 3
For j = k + 1 To 4
MsgBox Cells(i, k) & "-" & Cells(i, j) '確認用
Next j
Next k
End Sub
で良いと思います。これを全行について行い、同じ組み合わせが既にないかチェックすれば良いでしょう。上記(6)に注意して。
    • good
    • 0
この回答へのお礼

御回答ありがとうございます。

実際に試してみましたが、結果がセルに表示されませんでした。
ん~、難しいかな。。。


考えてみたのですが、例のデータを参考にすると、
B列とC列を検索対象にして、その中で「B=C」の条件を満たすものだけをカウントしていくというのはどうでしょう?
COUNTIF関数を使用していろいとと試しているのですが、なぜか上手くいきません(ー_ー;

でもかなりの労力を要するには変わりませんが。。。

もうちょっと、試行錯誤してみます。

お礼日時:2003/05/17 10:01

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング