[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ＶＢＡ 組み合わせの抽出方法』（julius）
はじめまして。
ＶＢＡでプログラムを組もうとしているのですが、
初心者で分からないことが多く、質問させて頂きます。
ｉ ｊ ｋ
Ａ 5 1
Ｂ 10 2
Ｃ 15 3
Ｄ 20 4
Ｅ 25 5
それぞれの列i,j,kに数値が入力されており、k列の数字から１つ、
あるいは２つの組み合わせを重複せず抽出したいです。
ただし、条件として、
２つ目以降の数字は１つ目よりも大きい ｊ列に対応する数字が２つ目以降は１つ目との差が10以上となるもの。 (iがＡとＢの場合、ｊの差は15-5=10なので成立し13)
どのようなプログラムになるのでしょうか。
勉強も含め教えて頂けると幸いです。
不躾で申し訳ありませんが、よろしくお願いします。
＜ 使用 Excel：Excel2010、使用 OS：WindowsXP ＞
質問の意味がわかりません。
＞それぞれの列i,j,kに数値が入力されており、k列の数字から１つ、 ＞あるいは２つの組み合わせを重複せず抽出したいです。 まず、Iは数値じゃないですよね？
それとK列の数値の組み合わせを抽出したいということですが、 「重複」の定義は何ですか？ 組み合わせの重複？ それとも同じ数値を使うことを重複？
上記例の場合、1-3 1-4 1-5 も条件に一致します。
最終的にどのような出力にしたいかわからないから 回答が付かないのではないかと思います。 例題の模範解答を作ってみてください。
（稲葉） 2015/09/04(金) 12:40
まず、
Ｉは数字ではありません。
重複は同じ数字を使うことを重複としています。
解答例としては、
1-3, 1-4, 1-5, 2-4, 2-5, 3-5
となります。
（julius） 2015/09/04(金) 13:53
横から失礼します。 組み合わせといっておられますが、１桁目が２桁目より云々という説明がありますよね。 ということは、組合せではなく順列ですか？
算数音痴ですのでβが回答できるテーマではないのですが、ちょっと気になりましたので。
（β） 2015/09/04(金) 14:35
引き続き分からないです。
＞１つ、 あるいは２つの組み合わせを重複せず抽出したいです。 と云うことは、
＞1-3, 1-4, 1-5, 2-4, 2-5, 3-5 となります。 １．その２つの組合せの前に、1,2,3,4,5 の単発が無いとおかしくないですか？
＞順列になりますね。 ２．と云うことは、ここの「5」が「1」だった場合、1-1とか、2-1などもありですね？ ↓ ＞Ｅ 25 5
３．※ それともK列には、そもそも同じ値が存在しない？ ４．※ K列は昇順にならんでいるのですか？
５．I列のA,B,C・・は、何か意味があるんですか？
あとの処理で使用するものですか？
それとも単に説明の都合上書いた文字なんですか？
（半平太） 2015/09/04(金) 15:58
１.仰る通り抜けていました。単発で１,2,3,4,5の単発が存在します。
３．分かりにくく申し訳ないんですが、Ｋ列は同じ値が存在しません。
４．昇順にならんでいます。
５．ｉ列は後の処理で使用するもので、この質問上では意味はありません。
（julius） 2015/09/04(金) 16:56
算数音痴ですが、 J・K列を新しいシートにコピーして、J列（コピー先のA列）で並べ替え J列（コピー先のA列）を順番に比較して、 一番最初に10離れたところから、最後まで K列（コピー先のB列）を組み合わせる 以上をJ列の数値分繰り返して総当たり
単発がないとおかしいのかどうか、私にはわかりませんが 一つ目と二つ目の差が10以上ないといけないなら、単発は発生しないような・・・ という考えで何も入れてません。 有ったとしても全部が該当するでしょうし。
Option Explicit
Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng As Range
Dim i As Long
Dim j As Long
Dim tbl
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets.Add
ws1.Range("K1", ws1.Range("J" & Rows.Count).End(xlUp)).Copy ws2.Range("A1")
Set rng = ws2.Range("A1", ws2.Range("B" & Rows.Count).End(xlUp))
With ws2.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
tbl = rng.Value
For i = 1 To UBound(tbl, 1)
For j = i + 1 To UBound(tbl, 1)
If tbl(i, 1) <= tbl(j, 1) - 10 Then
stest dic, tbl, i, j
Exit For
End If
Next j
Next i
ws1.Range("L1").Resize(dic.Count).Value = Application.Transpose(dic.keys)
Application.DisplayAlerts = False
ws2.Delete
Application.DisplayAlerts = True
End Sub
Private Sub stest(ByRef dic As Object, ByVal tbl, iMe As Long, iNext As Long)
Dim i As Long
For i = iNext To UBound(tbl, 1)
dic.Add tbl(iMe, 2) & "--" & tbl(i, 2), ""
Next i
End Sub
（稲葉） 2015/09/04(金) 18:12
K列は同じ値が存在せず、すでに昇順に並んでいる という前提なら、こういう話でしょうか。
I列 J K →結果 M列
1 A 5 1 1-3
2 B 10 2 1-4
3 C 15 3 1-5
4 D 20 4 2-4
5 E 25 5 2-5
3-5
----------------
Sub test1()
Dim j As Long
Dim k As Long
Dim p As Long
Columns("M").NumberFormatLocal = "@"
For j = 1 To 5
For k = j + 1 To 5
If Abs(Cells(j, "J").Value - Cells(k, "J").Value) >= 10 Then
p = p + 1
Cells(p, "M").Value = j & "-" & k
End If
Next
Next
End Sub
判りやすさを優先して、5といった数値をそのまま使っていますが、 実際に合わせてEndプロパティを使ったものに修正してください。
（γ） 2015/09/05(土) 16:46
j,k は行番号なので、正確には、
Cells(p, "M").Value = Cells(j, "K").Value & "-" & Cells(k, "K").Value
がよいのかもしれない。今は、同じ結果になるが。
もしくは、識別のために付けた文字列がI列だとすると、
Cells(p, "M").Value = Cells(j, "I").Value & "-" & Cells(k, "I").Value
とするかですね。
（γ） 2015/09/05(土) 18:17
（julius） 2015/09/07(月) 12:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.