[Excel] 複数の数値から条件にあった数値の組を抽出するには？

Question

こんにちは。
Excelを用いて、数百個の数値のデータの羅列から、差が(N±n)の条件に合うような数値の組だけを抽出する事はできるでしょうか？
例えば差が(80±5)の組を抽出するのであれば、絶対値差が75～85の組のみを抽出するという感じなのですが・・・。
N,nについては自由に決められるようにしたいのですが、初歩的ななExcelの知識しかなく、マクロにも明るくないため自力では解決の糸口が見つかりません。
また、Excelに限らず、「○○というソフトを使えばできる」等の情報でも大歓迎です。

皆様のお力をお貸しいただければ幸いです。宜しくお願い致します。

pauNed · Accepted Answer

No.8補足へのレスです。
>これを少数点以下を保持したまま抽出する方法はあるでしょうか？
変数の型をLong（長整数）型にしていますから、整数化されています。
下記のように修正すれば可能です。
■が修正箇所。
ついでに、G列に差異を書き出すようにしましたので、
念のためチェック入れてもよいかもしれません。

Sub sample3()
　　Dim r　As Range
　　Dim n1 As Double '■
　　Dim n2 As Double '■
　　Dim mn As Double '■
　　Dim x　As Long
　　Dim y　As Long
　　Dim i　As Long
　　Dim k　As Long
　　Dim z(1 To 65535, 1 To 3) As Double '■

　　n1 = Range("B1").Value
　　n2 = Range("B2").Value
　　With Range("A1", Range("A65536").End(xlUp))
　　　　With .Offset(, 2)
　　　　　　.Value = .Offset(, -2).Value
　　　　　　.Sort Key1:=.Cells(1), _
　　　　　　　　　Order1:=xlAscending, _
　　　　　　　　　Header:=xlNo, _
　　　　　　　　　OrderCustom:=1, _
　　　　　　　　　Orientation:=xlTopToBottom
　　　　　　For Each r In .Cells
　　　　　　　　mn = r.Value + n1
　　　　　　　　x = Application.Match(mn, .Cells)
　　　　　　　　If .Cells(x).Value = mn Then
　　　　　　　　　　x = Application.Match(mn - 1, .Cells)
　　　　　　　　End If
　　　　　　　　x = x + 1
　　　　　　　　y = Application.Match(r.Value + n2, .Cells)
　　　　　　　　If x <= y Then
　　　　　　　　　　For i = x To y
　　　　　　　　　　　　k = k + 1
　　　　　　　　　　　　z(k, 1) = r.Value
　　　　　　　　　　　　z(k, 2) = .Cells(i).Value
　　　　　　　　　　　　z(k, 3) = z(k, 2) - z(k, 1) '■
　　　　　　　　　　Next i
　　　　　　　　End If
　　　　　　Next r
　　　　End With
　　End With
　　If k > 0 Then
　　　　Range("E1:G1").Resize(k).Value = z '■
　　End If
End Sub

pauNed · Answer

修正です。
Sub sample2()
　　Dim r　As Range
　　Dim n1 As Long
　　Dim n2 As Long
　　Dim mn As Long
　　Dim x　As Long
　　Dim y　As Long
　　Dim i　As Long
　　Dim k　As Long
　　Dim z(1 To 65535, 1 To 2) As Long

　　n1 = Range("B1").Value
　　n2 = Range("B2").Value
　　With Range("A1", Range("A65536").End(xlUp))
　　　　With .Offset(, 2)
　　　　　　.Value = .Offset(, -2).Value
　　　　　　.Sort Key1:=.Cells(1), _
　　　　　　　　　Order1:=xlAscending, _
　　　　　　　　　Header:=xlNo, _
　　　　　　　　　OrderCustom:=1, _
　　　　　　　　　Orientation:=xlTopToBottom
　　　　　　For Each r In .Cells
　　　　　　　　mn = r.Value + n1
　　　　　　　　x = Application.Match(mn, .Cells)
　　　　　　　　If .Cells(x).Value = mn Then
　　　　　　　　　　x = Application.Match(mn - 1, .Cells)
　　　　　　　　End If
　　　　　　　　x = x + 1
　　　　　　　　y = Application.Match(r.Value + n2, .Cells)
　　　　　　　　If x <= y Then
　　　　　　　　　　For i = x To y
　　　　　　　　　　　　k = k + 1
　　　　　　　　　　　　z(k, 1) = r.Value
　　　　　　　　　　　　z(k, 2) = .Cells(i).Value
　　　　　　　　　　Next i
　　　　　　　　End If
　　　　　　Next r
　　　　End With
　　End With
　　If k > 0 Then
　　　　Range("E1:F1").Resize(k).Value = z
　　End If
End Sub

pauNed · Answer

こんにちは。
あまり深くは考えていないのですが、
ソートして差の下限値と上限値をMATCH関数でチェックすればいいような気もしますね。

下記はあまり効率良くないかもしれませんが
A列にデータがあるとして、B1セルに下限値、B2セルに上限値を入力してテストしてみてください。
（ご提示の例でいえばB1=75 B2=85）

C列にコピーしてソートし、E:F列に結果を書き出します。

Sub sample()
　　Dim v, z()
　　Dim mn As Long
　　Dim x As Long
　　Dim y As Long
　　Dim i As Long
　　Dim j As Long
　　Dim k As Long
　　Dim n1 As Long
　　Dim n2 As Long

　　n1 = Range("B1").Value
　　n2 = Range("B2").Value
　　With Range("A1", Range("A65536").End(xlUp))
　　　　.Offset(, 2).Value = .Value
　　　　With .Offset(, 2)
　　　　　　.Sort Key1:=Range("C1"), _
　　　　　　　　　Order1:=xlAscending, _
　　　　　　　　　Header:=xlNo, _
　　　　　　　　　OrderCustom:=1, _
　　　　　　　　　Orientation:=xlTopToBottom
　　　　　　v = Application.Transpose(.Value)
　　　　End With
　　End With
　　For i = 1 To UBound(v)
　　　　With Application
　　　　　　mn = v(i) + n1
　　　　　　x = .Match(mn, v)
　　　　　　If v(x) = mn Then
　　　　　　　　x = .Match(mn - 1, v) + 1
　　　　　　ElseIf v(x) < mn Then
　　　　　　　　x = x + 1
　　　　　　End If
　　　　　　y = .Match(v(i) + n2, v)
　　　　End With
　　　　If x <= y Then
　　　　　　For j = x To y
　　　　　　　　k = k + 1
　　　　　　　　ReDim Preserve z(1 To 2, 1 To k)
　　　　　　　　z(1, k) = v(i)
　　　　　　　　z(2, k) = v(j)
　　　　　　Next j
　　　　End If
　　Next i
　　If k = 0 Then Exit Sub
　　Range("E1:F1").Resize(k).Value = vTrans(z)
End Sub

Private Function vTrans(v As Variant) As Variant
　　Dim L1 As Long, U1 As Long
　　Dim L2 As Long, U2 As Long
　　Dim rn As Long, cn As Long
　　Dim i　As Long, j　As Long
　　
　　L1 = LBound(v)
　　U1 = UBound(v)
　　L2 = LBound(v, 2)
　　U2 = UBound(v, 2)
　　cn = 0
　　ReDim x(1 To U2 - L2 + 1, 1 To U1 - L1 + 1)
　　For i = L1 To U1
　　　　rn = 0
　　　　cn = cn + 1
　　　　For j = L2 To U2
　　　　　　rn = rn + 1
　　　　　　x(rn, cn) = v(i, j)
　　　　Next j
　　Next i
　　vTrans = x
End Function

うまくいかなかったらごめんなさい。

imogasi · Answer

多数の数値があって、その中から、任意に２つの数を取り、差を作って、
差がある範囲（それもBetween)のものの組だけを、ピックアップして
一覧を作るという問題のようですね。
これはプログラムでないと実現しないし、２つのくみの数もデータ数が増えると増加するので、計算回数も大変になる。
こんなものをエクセル（（多分関数）でやろうなんて無理ですよ。
数学のカテゴリで、この質問に適した良いアルゴリズムがないか質問してみたら。
事務系プログラマは数学的な勉強は余り必要でないことが多く、このカテゴリでは、回答も少ないようですよ。
「集合の２点の距離について、ある範囲内の、２点の組み（合わせ）（数）を数える」ということになるのかな。

cafe_au_lait · Answer

とりあえず見るだけなら

データが昇順でA1:A1000にあるとして、
B1:=INDEX($A$1:$A$400,MATCH($A1+80-5,$A$1:$A$1000)+COLUMN(B1)-COLUMN($B1))
とします。
次に条件付き書式で「セルの値が」「次の値の間」を選択し、
"$A1+80-5"、"$A1+80+5"と入力します。
条件が真のときの書式を目立つように設定します。
これを右と下にコピーすると、候補の数字が出てきます。

80と5はセル参照にできます。

並べたい場合は補足してください。

mshr1962 · Answer

#2です。色付けで判定でいいなら
「書式」「条件付き書式」で
「セルの値が」「次の値の間」「=前のセル+$A$1-$A$2」「=後のセル-$A$1+$A$2」
として書式ボタンを押して、文字色の変更か塗りつぶしを設定してください。
最初と最後のセルだけは
「セルの値が」「次の値以上」「=後のセル-$A$1+$A$2」
「セルの値が」「次の値以下」「=前のセル+$A$1-$A$2」
になりますけど．．．

nobu555 · Answer

可視的に表示を変えるだけなら、
「オートフィルタ」という機能があります。

メニューバー「データ」から
「フィルタ」「オートフィルタ」を選択します。
（項目が無い場合、先頭の行は範囲外になります。
また、途中空白のセルが無ければ自動で範囲設定します。
ただし、データ範囲内のセルがアクティブの時のみです。）

次に、項目セルの所に”▼”ボタンが付きますのでクリックして、
ドロップダウンリストから「（オプション）」を選択します。

すると、”抽出条件の指定”とありますので、
例題の場合、左上段の”▼”をクリックして”75”を選択、
右上段の”▼”をクリックして”以上”を選択、
左下段の”▼”をクリックして”85”を選択、
右下段の”▼”をクリックして”以下”を選択して
”ＯＫ”ボタンをクリックすると、
条件にあった数値の行のみ表示します。
解除する時は、また「オートフィルタ」を選択します。

これで出来ますよ。

mshr1962 · Answer

縦列に数字があるなら「データ」「フィルタ」「オートフィルタ」で
▼を押して「オプション」を選択して
「N-n」「以上」
●And　○Or
「N+n」「以下」
で抽出する。

別のセルを利用してでいいなら　A1=N,A2=nを入力　B1に判定する数値があるなら
=IF(AND(B1>=$A$1-$A$2,B1<=$A$1+$A$2),"OK","NG")
としてこの式をコピーして判定

noname#62235 · Answer

ワークシート関数とオートフィルタの組み合わせで、簡単に出来ると思います。

数列内の最大値を求める

=max(範囲)

数列内の最小値を求める

=min(範囲)

数列が最大値と最小値の間に収まっている場合"○"を返す

=if(and((max(範囲)<=最大値),(min(範囲)=>最小値)), "○", "")

後は丸のついている行だけ抽出する。

[Excel] 複数の数値から条件にあった数値の組を抽出するには？

No.8補足へのレスです。

修正です。

こんにちは。

多数の数値があって、その中から、任意に２つの数を取り、差を作って、

とりあえず見るだけなら

#2です。

可視的に表示を変えるだけなら、

縦列に数字があるなら「データ」「フィルタ」「オートフィルタ」で

ワークシート関数とオートフィルタの組み合わせで、簡単に出来ると思います。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング