こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

office2016

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

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

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

登録されているシリアルの数が多い(4万件ほど)ので、先頭1桁目の文字列、先頭2桁目の文字列抽出、先頭3桁目の文字列抽出、先頭4桁目の文字列抽出をし、
あとは、先頭4桁で絞ったシリアル番号の集まりにして、その中からプルダウンメニューで対象のシリアル番号を特定させるという構成にしています。
シリアル番号の桁数は8桁。先頭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からインポートしたデータ表示
A列:シリアル番号
B列:工事名称
C列:シリアル番号の1桁目表示
D列:シリアル番号の2桁目表示
E列:シリアル番号の3桁目表示
F列:シリアル番号の4桁目表示
G2セル:MENUシートで先頭4桁の番号表示 =MENU!A13&MENU!B13&MENU!C13&MENU!D13
H列:インポートしたシリアル番号の先頭1桁目に使用されている文字列表示
I列:インポートしたシリアル番号の先頭2桁目に使用されている文字列表示
J列:インポートしたシリアル番号の先頭3桁目に使用されている文字列表示
K列:インポートしたシリアル番号の先頭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桁目から3桁目まではマクロ動作させず、4桁目を指定した後にマクロ実行するという手もありますが、後から2桁目の文字だけ変更して別のシリアル番号検索という場合もあるので対応できません。
CTRL+Fで工事番号を手入力して検索したらすぐに探せますが、手入力は面倒なので、先頭4桁の文字をプルダウンで特定して絞り込むという構成のままで検索時間の短縮が図れる構成としたいです。
マクロに関してはベタで教えていただきたく。

投稿日時 - 2019-09-10 14:25:29

QNo.9655377

暇なときに回答ください

質問者が選んだベストアンサー

修正してみました。
多分、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

投稿日時 - 2019-09-10 17:52:49

お礼

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

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

イベントで実行するのではなく、抽出条件の設定が終わったらボタンを押してマクロを走らせる、という方法もありますね。
或いは、4文字全てが入力されていなければマクロが走らないようにする。
を参考にさせていただき、E10セルに工事番号を手入力で対応する構成としました。
工事番号を検索するのに、後方4桁の数字部分が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")
です。

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

投稿日時 - 2019-09-12 16:43:55

ANo.2

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(2)

ANo.1

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

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

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

投稿日時 - 2019-09-10 17:47:16

お礼

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

投稿日時 - 2019-09-12 16:27:53

あなたにオススメの質問