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

質問

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

皆様のお力をお貸しいただければ幸いです。宜しくお願い致します。

回答No.9

pauNed · ベストアンサー

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

お礼

なんというか・・・本当にありがとうございます。
素早いレス、的確な回答、本当に助かりました。

目視で丸三日かかっていた作業が数時間で終わるようになりました。
重ね重ね本当にありがとうございました。

回答No.8

pauNed

修正です。
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

お礼

お礼が遅れてしまって申し訳ありません。
修正後のマクロを利用してみたところ、目的の誤差以内の組を抽出する事がきました。
今まで目視での数値抽出にかなりの時間を割いていたため、教えていただいたマクロですごく助かりました。

ただ、一つだけ疑問なのですが。
私が用いている数値の羅列は小数点以下２桁迄のデータで、例えば(1251.11,1331.21)のような組の場合でも、抽出されて表示されるのは(1251,1331)のように整数に丸められてしまっています。
これを少数点以下を保持したまま抽出する方法はあるでしょうか？

回答に質問を重ねてしまい申し訳ありません。よろしければお答えいただくとうれしいです。

回答No.7

pauNed

こんにちは。
あまり深くは考えていないのですが、
ソートして差の下限値と上限値を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

うまくいかなかったらごめんなさい。

お礼

お礼が遅れてしまって申し訳ありません。
修正後のマクロを利用してみたところ、目的の誤差以内の組を抽出する事がきました。
今まで目視での数値抽出にかなりの時間を割いていたため、教えていただいたマクロですごく助かりました。

ただ、一つだけ疑問なのですが。
私が用いている数値の羅列は小数点以下２桁迄のデータで、例えば(1251.11,1331.21)のような組の場合でも、抽出されて表示されるのは(1251,1331)のように整数に丸められてしまっています。
これを少数点以下を保持したまま抽出する方法はあるでしょうか？

回答に質問を重ねてしまい申し訳ありません。よろしければお答えいただくとうれしいです。

回答No.6

imogasi

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

お礼

このような問題はエクセルでは難しいのですね・・・。やはり解析系のソフトがあったほうがよいのでしょうか。
ただ、pauNed様よりいただいか回答のマクロで問題は解決できそうなようでした。
カテゴリの違うところの質問でしたが丁寧にご注意いただきありがとうございました。

回答No.5

cafe_au_lait

とりあえず見るだけなら

データが昇順で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はセル参照にできます。

並べたい場合は補足してください。

回答No.4

mshr1962

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

回答No.3

nobu555

可視的に表示を変えるだけなら、
「オートフィルタ」という機能があります。

メニューバー「データ」から
「フィルタ」「オートフィルタ」を選択します。
（項目が無い場合、先頭の行は範囲外になります。
また、途中空白のセルが無ければ自動で範囲設定します。
ただし、データ範囲内のセルがアクティブの時のみです。）

次に、項目セルの所に”▼”ボタンが付きますのでクリックして、
ドロップダウンリストから「（オプション）」を選択します。

すると、”抽出条件の指定”とありますので、
例題の場合、左上段の”▼”をクリックして”75”を選択、
右上段の”▼”をクリックして”以上”を選択、
左下段の”▼”をクリックして”85”を選択、
右下段の”▼”をクリックして”以下”を選択して
”ＯＫ”ボタンをクリックすると、
条件にあった数値の行のみ表示します。
解除する時は、また「オートフィルタ」を選択します。

これで出来ますよ。

お礼

素早い回答ありがとうございます。
丁寧に記述いただき感謝していますありがとうございます。ただ、回答内容が少し質問内容とは異なるようです。
私の質問が分かりにくかったようで申し訳ありません。
複数の数値のうち差が(N±n)になる「数値の組」を抽出する方法を探しています。
例えば(300,1130,1200,1750,1821,2530,3821)という数値から差が(80±5)に納まる(1130,1200)、(1750,1821)という２つの「数値の組」を抽出したいのです。
元の数値が数百から数千近くあるためとても視認作業では無理なため、関数等を用いて解決できないかと質問をいたしました。

誤解を招くような質問で申し訳ありません。
解決法を知っている方がいらっしゃいましたらどうが宜しくお願い致します。

回答No.2

mshr1962

縦列に数字があるなら「データ」「フィルタ」「オートフィルタ」で
▼を押して「オプション」を選択して
「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")
としてこの式をコピーして判定

お礼

素早い回答ありがとうございます。
丁寧に記述いただき感謝しています。ありがとうございます。ただ、上記回答者様のnobu555様と同じ回答内容が少し質問内容とは異なるようです。
私の質問が分かりにくかったようで申し訳ありません。
複数の数値のうち差が(N±n)になる「数値の組」を抽出する方法を探しています。
例えば(300,1130,1200,1750,1821,2530,3821)という数値から差が(80±5)に納まる(1130,1200)、(1750,1821)という２つの「数値の組」を抽出したいのです。
元の数値が数百から数千近くあるためとても視認作業では無理なため、関数等を用いて解決できないかと質問をいたしました。

誤解を招くような質問で申し訳ありません。
解決法を知っている方がいらっしゃいましたらどうが宜しくお願い致します。
「お礼」内容が他の回答者様と同じ複写になりますが申し訳ありません。

回答No.1

noname#62235

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

数列内の最大値を求める

=max(範囲)

数列内の最小値を求める

=min(範囲)

数列が最大値と最小値の間に収まっている場合"○"を返す

=if(and((max(範囲)<=最大値),(min(範囲)=>最小値)), "○", "")

後は丸のついている行だけ抽出する。

お礼

素早い回答ありがとうございます。
丁寧に記述いただき感謝しています。ありがとうございます。ただ、上記回答者様２名様と同じく、回答内容が少し質問内容とは異なるようです。
私の質問が分かりにくかったようで申し訳ありません。
複数の数値のうち差が(N±n)になる「数値の組」を抽出する方法を探しています。
例えば(300,1130,1200,1750,1821,2530,3821)という数値から差が(80±5)に納まる(1130,1200)、(1750,1821)という２つの「数値の組」を抽出したいのです。
元の数値が数百から数千近くあるためとても視認作業では無理なため、関数等を用いて解決できないかと質問をいたしました。

誤解を招くような質問で申し訳ありません。
解決法を知っている方がいらっしゃいましたらどうが宜しくお願い致します。
「お礼」内容が他の回答者様と同じ複写になりますが申し訳ありません。