対象値(時間)に近いデータを抽出する方法について

若干丸投げしているような質問と捉えてしまう方もいるかと思いますが、
ネット検索やエクセル関数、Worksheet.functionキー等自分なりに処理を行った上での
質問となりますので、どなたかご教示頂けると幸いです。

現状、エクセル上関数では以下のように組み合わせて抽出はできていますが、
20万を超えるデータがあり、エクセル関数の場合都度自動計算が行われて作業が円滑に進まない状況にあります。
そのため、VBA上で処理を行い、値を反映させたいと考えています。

▼現在使用しているエクセル関数
=INDEX(D2:H2,MATCH(MIN(ABS(D2:H2-C2)),ABS(D2:H2-C2),0))
※配列数式

自分なりにネットから検索してみたのですが、Worksheet.functionキーを用いた処理サンプルしか
見当たりませんでした。

やはりWorksheet.functionキーを使用しないと抽出は難しいでしょうか。
仮にWorksheet.functionキーを使用せずVBA上で動かす方法がありましたら、
ご教示頂けないでしょうか。

行動規範の内容に同意します

回答2件

ベストアンサー

VBAで式を設定して、値代入するのが簡単かと。

vba
1Sub Test()
2    With Worksheets(1).Range("h2:h" & Worksheets(1).Range("A2").End(xlDown).Row)
3        .Formula2 = "=INDEX(C2:G2,MATCH(MIN(ABS(C2:G2-B2)),ABS(C2:G2-B2),0))"
4        .Value = .Value
5    End With
6End Sub

20万のサンプルデータを作成して計測してみましたが、2秒弱で終わりました。

追記
Excel365で試したのでうまくいきましたが、スピル機能のないバージョンだとうまくいかないかも。
その場合は、配列数式を手作業で入力してから、値貼り付けで値化するといいでしょう。

VBAでセル範囲のデータを配列に格納してループで走査する方法でやってみました。

vba
1Sub test2()
2    Dim tbl() As Variant
3    tbl = Worksheets(1).Range("B2:G" & Worksheets(1).Range("A2").End(xlDown).Row).Value
4    Dim res() As Variant: ReDim res(1 To UBound(tbl), 1 To 1)
5    Dim r As Long, c As Long
6    For r = 1 To UBound(tbl)
7        Dim minDiff As Date, nearTime As Date
8        nearTime = tbl(r, 2)
9        minDiff = Abs(nearTime - tbl(r, 1))
10        For c = 3 To 6
11        Dim diff As Date: diff = Abs(tbl(r, c) - tbl(r, 1))
12            If minDiff > diff Then
13                minDiff = diff
14                nearTime = tbl(r, c)
15            End If
16        Next
17        res(r, 1) = nearTime
18    Next
19    Worksheets(1).Range("H2").Resize(UBound(res)).Value = res
20End Sub

こちらも2秒弱でした。

追記

あれから少し気になったので、配列数式をコピーできないか試してみました。下記でできるようです。
ただし、365での確認ですので、古いバージョンのエクセルで実際にできるかは分かりません。

vba
1Sub Test()
2    Dim lastRow As Long
3    With Worksheets(1)
4        lastRow = .Range("A2").End(xlDown).Row
5        .Range("h2").FormulaArray = "=INDEX(C2:G2,MATCH(MIN(ABS(C2:G2-B2)),ABS(C2:G2-B2),0))"
6        .Range("h2").Copy Destination:=.Range("h3:h" & lastRow)
7        With .Range("h2:h" & lastRow)
8            .Value = .Value
9        End With
10     End With
11End Sub

投稿2021/11/08 13:37

編集2021/11/08 23:42

hatena19

総合スコア33790

quark87139

2021/11/08 20:35 編集

hatena19さん 2つの方法をご提示いただきありがとうございます。これまでで一番といっても過言でないぐらい勉強になりました..。 1つ目のコードについてそもそも、Worksheet.functionとは別にエクセル関数をVBA上で直接入れて処理するやり方もあるんですね。無知ですみませんが、僕の中では一番衝撃だったかも知れないです。 ※ただ記載あるように、僕の所持しているバージョンが古かったようでおもった結果にはなりませんでしたが、そういうやり方もあることを把握することで今後、選択肢の幅は広がったので感謝です。 2つ目のコードについて全てそうだとは言い切れないですが、 =INDEX(C2:G2,MATCH(MIN(ABS(C2:G2-B2)),ABS(C2:G2-B2),0)) 当初利用していたエクセル関数の処理内訳はきっと2つ目のコードを集約したものなんだろうと思いました。自分なりに解釈して以下2つ目のコード部分を文言化しました。 (r=1,c=1) 対象範囲(比較対象としたい範囲)を配列へ格納 ↓ 結果を格納する配列作成 ↓ 以下Loop 配列内2列目の値を変数格納(nearTime:tble(1,2)) ↓ nearTimeと指定値(tble(1,1))の差分を変数(minDiff:nearTime-指定値) ↓ 検索値(tble(1,1)と指定値(tble(1,1)の差分を変数(diff:tble(1,1)-指定値) ↓ (各差分をifで比較) mindiffの方が大きい場合、mindiffにdiffの値を格納し、nearTimeに検索値(tble(1,1))を格納 diffの方が大きい場合、最初へ戻る ↓ 結果を配列格納丁寧なコード記載のおかげで思い通りの結果を得ることができました。個人的には結果よりもそれ以上に得られるものが大きかったです。ありがとうございました。

行動規範の内容に同意します