シリアル番号検索を早くする方法

質問

office2016

（１）ORACLEからシリアル番号とその工事名称をexcelへインポート
（２）シリアル番号に対する工事名称を確認して、作業工程のデータを作成
（３）作成した作業工程のデータをORACLEへ登録

というデータ作成をしています。

もともとは、（１）、（２）は無しで対応していたのですが、シリアル番号を手入力すると間違えるので、（１）、（２）の内容を追加しました。

登録されているシリアルの数が多い（４万件ほど）ので、先頭1桁目の文字列、先頭２桁目の文字列抽出、先頭３桁目の文字列抽出、先頭４桁目の文字列抽出をし、
あとは、先頭4桁で絞ったシリアル番号の集まりにして、その中からプルダウンメニューで対象のシリアル番号を特定させるという構成にしています。
シリアル番号の桁数は８桁。先頭4桁は英数文字、後半４桁はほぼ数字。若干英文字混じる。

MENUシート
工事番号の絞り込みとその工事番号の名称表示を実施
A13セル：シリアル番号1桁目を表示。入力規則　=SERIAL!$H:$H
B13セル：シリアル番号2桁目を表示。入力規則　=SERIAL!$iI$I
C13セル：シリアル番号3桁目を表示。入力規則　=SERIAL!$J:$J
D13セル：シリアル番号4桁目を表示。入力規則　=SERIAL!$K:$K
E13セル：8桁のシリアル番号表示。入力規則　=KOJI!$A:$A

SERIALシート
ORACLからインポートしたデータ表示
Ａ列：シリアル番号
B列：工事名称
Ｃ列：シリアル番号の1桁目表示
Ｄ列：シリアル番号の2桁目表示
Ｅ列：シリアル番号の3桁目表示
Ｆ列：シリアル番号の4桁目表示
G2セル：MENUシートで先頭4桁の番号表示　=MENU!A13&MENU!B13&MENU!C13&MENU!D13
H列：インポートしたシリアル番号の先頭1桁目に使用されている文字列表示
Ｉ列：インポートしたシリアル番号の先頭2桁目に使用されている文字列表示
Ｊ列：インポートしたシリアル番号の先頭3桁目に使用されている文字列表示
Ｋ列：インポートしたシリアル番号の先頭4桁目に使用されている文字列表示

KOJIシート
先頭4桁で絞り込んだシリアル番号の集まりを表示する

マクロ
MENUシート
Private Sub Worksheet_Change(ByVal Target As Range)

If (Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 4) And Target.Row = 13 Then

chushutsu
Else

End If

標準モジュール
Sub chushutsu()

Application.ScreenUpdating = False

Sheets("KOJI").Select
Columns("A:B").Select

Selection.ClearContents

Sheets("SERIAL").Select

Range("G1") = "SERIAL"
Range("G2") = "=MENU!R[11]C[-6]&MENU!R[11]C[-5]&MENU!R[11]C[-4]&MENU!R[11]C[-3]"

'
Columns("A:B").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("G1:G2"), Unique:=False
'
Cells.Select
Selection.SpecialCells(xlCellTypeVisible).Select

Selection.Copy
Sheets("KOJI").Select
Range("A1").Select
ActiveSheet.Paste

ActiveWorkbook.Worksheets("KOJI").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("KOJI").Sort.SortFields.Add Key:=Range("A:A"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("KOJI").Sort
.SetRange Range("A:B")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Sheets("SERIAL").Select
ActiveSheet.ShowAllData

Sheets("MENU").Select

Application.ScreenUpdating = True

End Sub

問題なのは、MENUシートのA13,B13,C13,D13セルでプルダウンメニューから文字を選択する度にマクロが動作するのに、若干時間がかかること。
シリアル番号を検索するのに、基本、先頭1桁目から順番に絞り込みます。
なので計算方法を手動にしておき、先頭1桁目から３桁目まではマクロ動作させず、４桁目を指定した後にマクロ実行するという手もありますが、後から2桁目の文字だけ変更して別のシリアル番号検索という場合もあるので対応できません。
CTRL＋Fで工事番号を手入力して検索したらすぐに探せますが、手入力は面倒なので、先頭4桁の文字をプルダウンで特定して絞り込むという構成のままで検索時間の短縮が図れる構成としたいです。
マクロに関してはベタで教えていただきたく。

回答No.2

Mathmi · ベストアンサー

修正してみました。
多分、AdvancedFilterかSortの所で時間がかかっていると思うので、速度的にはあまり変わっていないかも知れませんが。

気になった点としては
・毎回selectするのは無駄です。時間がかかるだけでなく、エラーの遠因にもなります。
　今回は違うでしょうが、セルへの書き込みも結構時間がかかります。
・セル範囲の指定は、できれば1回だけにしたいです。作る時も修正する時も大変ですし、エラーの原因になります。
・画面更新だけではなく、イベントや自動計算も停止しておくと、早くなる事があります。
・どこで時間がかかっているかを調べれば、どこに注力して修正すればいいのか分かります。一度Timerを使って調べてみては？
以上です。
後、4文字全てではなく、一部分だけ指定して抽出できるようにしました。
（例えば、1文字目に1、4文字目にAを設定すると、111A、12BA、1C4A等が全てヒットする）

＞後から2桁目の文字だけ変更して別のシリアル番号検索という場合もある
イベントで実行するのではなく、抽出条件の設定が終わったらボタンを押してマクロを走らせる、という方法もありますね。
或いは、4文字全てが入力されていなければマクロが走らないようにする、という方法もあります。

Sub chushutsu()
　Dim i As Integer
　Dim myStr As String
　Dim wsMENU As Worksheet
　Dim wsSERIAL As Worksheet
　Dim wsKOJI As Worksheet
　Dim rangeInput As range 'MENUシートに入力するセル範囲
　Dim rangeCriteria As range 'SERIALシートにてフィルタ条件を設定するセル範囲。
　Dim rangeFilter As range 'SERIALシートにてフィルタをかけるセル範囲。
　Dim rangeSort As range 'KOJIシートにて抽出した文字列を出力し、ソートするセル範囲。

　'作業対象セル範囲を設定
　Set wsMENU = ActiveWorkbook.Worksheets("MENU")
　Set wsSERIAL = ActiveWorkbook.Worksheets("SERIAL")
　Set wsKOJI = ActiveWorkbook.Worksheets("KOJI")
　Set rangeInput = wsMENU.Cells(13, 1).Resize(1, 4)
　Set rangeCriteria = wsSERIAL.range("G1").Resize(2, 1)
　Set rangeFilter = wsSERIAL.range("A1", wsSERIAL.Cells(wsSERIAL.Rows.Count, 2).End(xlUp))
　Set rangeSort = wsKOJI.range("A:B")

　'コンストラクタ
　Application.EnableEvents = False
　Application.ScreenUpdating = False
　Application.Calculation = xlCalculationManual

　'フィルター用文字列を設定
　For i = 1 To rangeInput.Count
　　If IsEmpty(rangeInput(i)) Then
　　　myStr = myStr & "?"
　　Else
　　　myStr = myStr & rangeInput(i).Value
　　End If
　Next i
　rangeCriteria(1).Value = "SERIAL"
　rangeCriteria(2).Value = myStr

　'抽出先を先にクリア
　rangeSort.Clear

　'Autofilterで抽出したデータをKOJIに張り付け。
　rangeFilter.AdvancedFilter Action:=xlFilterCopy, _
　　　　　　　　　　　　　　 CriteriaRange:=rangeCriteria, _
　　　　　　　　　　　　　　 CopyToRange:=rangeSort(1), _
　　　　　　　　　　　　　　 Unique:=True

　'KOJIをソート
　With wsKOJI.Sort
　　.SortFields.Clear
　　.SortFields.Add Key:=rangeSort(1), _
　　　　　　　　　　SortOn:=xlSortOnValues, _
　　　　　　　　　　Order:=xlAscending, _
　　　　　　　　　　DataOption:=xlSortNormal
　　.SetRange rangeSort
　　.Header = xlYes 'タイトルあり
　　.MatchCase = False '大文字と小文字を区別しない
　　.Orientation = xlSortColumns '列方向で並べ替える
　　.Apply
　End With

　'デストラクタ
　Application.EnableEvents = True
　Application.ScreenUpdating = True
　Application.Calculation = xlCalculationAutomatic
End Sub

お礼

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

とても参考になりました。
やはり、４文字それぞれで検索するのは時間かかってしまいます。

イベントで実行するのではなく、抽出条件の設定が終わったらボタンを押してマクロを走らせる、という方法もありますね。
或いは、4文字全てが入力されていなければマクロが走らないようにする。
を参考にさせていただき、E10セルに工事番号を手入力で対応する構成としました。
工事番号を検索するのに、後方４桁の数字部分が2000くらいある場合、プルダウンで下まで探すのが面倒だとの意見があり、工事番号は手入力で好きな桁数だけ入れてE10セル値変更で実行する様にしました。

　For i = 1 To rangeInput.Count
　　If IsEmpty(rangeInput(i)) Then
　　　myStr = myStr & "?"
　　Else
　　　myStr = myStr & rangeInput(i).Value
　　End If
　Next i

の部分を
myStr = Range("E10")
です。

好きな桁数の文字列で検索できるので、次の工事番号検索も簡単に早く出来るさまになりました。

回答No.1

HohoPapa

>A13セル：シリアル番号1桁目を表示。入力規則　=SERIAL!$H:$H
>B13セル：シリアル番号2桁目を表示。入力規則　=SERIAL!$iI$I
>C13セル：シリアル番号3桁目を表示。入力規則　=SERIAL!$J:$J
>D13セル：シリアル番号4桁目を表示。入力規則　=SERIAL!$K:$K
これら４つのセルの何れかが書き換わると
chushutsu が起動する　という動作になっているものと理解しました。

例えば、
課題ブックが開いたとき、あるいはMENUシートが選択された時に
マクロが、A13,B13,C13,D13を空欄にする
（この動作ではchushutsu が起動しないように制御します。）

その後
A13,B13,C13,D13の何れかが書き換わり、
かつ、
A13,B13,C13,D13の何れもNull（空欄）ではないときに
chushutsu が起動する。というコードにすれば、
期待の動作になるものと思いますがいかがでしょうか？

お礼

回答ありがとうございます。
考え方、参考になりました。
しかしながら、最初A13,B13,C13,D13が空欄はよいのですが、次にそのまま継続する時は、A13,B13,C13,D13は空欄になっていません。
この状態でC13を変更し、B13を変更とすると、時間がかかってしまいます。