EXCEL マクロ MATCH関数で高速化。
以下は、OLD商品とNEW商品の差分(新規・更新)をチェックしてマークを入れるマクロです。
通常はマクロのFINDで処理してますが、データ量が多いときにFINDではなく、MATCH関数併用で高速化できるので紹介します。FINDもコメントで残しておきます。
※比較で、おおよそ40%強UP。
「★START1★」シートのH1に以下関数を書きます。
=IFERROR(MATCH(G1,OLD商品!A1:A200000,0),"")
' Dim mySheetName001 As Variant Dim mySheetName002 As Variant Dim TSTART As Single Dim TEND As Single Dim vFILENAME As Variant Dim MSG_FLG As String Dim CNT10 As Long Dim WORK01 As String Dim MyRange1 Dim kensaku1 Dim set_data01 As Object Dim set_data02 As Object mySheetName001 = "NEW商品" mySheetName002 = "OLD商品" MSG_FLG = MsgBox(" 照合処理OKですか?◆ ", vbYesNo) If MSG_FLG = vbNo Then Exit Sub End If '### timer ### TSTART = Timer Application.ScreenUpdating = False ' ***クリア処理*** ※別ブログに度々出てきますので参照して下さい。 '### シートフィルタ解除サブプロシジー ### sheet_clear CNT10 = 0 Set set_data01 = Worksheets(mySheetName001).Range("A1") Set set_data02 = Worksheets(mySheetName002).Range("A1") Do Until set_data01.Offset(0, 0).value = "" '########## 照合処理 ############# Worksheets("★START1★").Range("G1").value = set_data01.Offset(0, 0).value WORK01 = Worksheets("★START1★").Range("H1").value If Worksheets("★START1★").Range("H1").value = "" Then set_data01.Offset(0, 2).value = "New" ElseIf set_data01.Offset(0, 1).value = set_data02.Offset(WORK01 - 1, 1).value Then set_data01.Offset(0, 2).value = "NO" Else set_data01.Offset(0, 2).value = "Yes" End If '########## FINDを使用した場合です ############# ' kensaku1 = set_data01.Offset(0, 0).value ' Set MyRange1 = Worksheets(mySheetName002).Columns(1).Find(kensaku1, LookAt:=xlWhole) ' ' If Not MyRange1 Is Nothing Then ' set_data01.Offset(0, 2).value = "Yes" ' If set_data01.Offset(0, 1).value = MyRange1.Offset(0, 1).value Then ' set_data01.Offset(0, 2).value = "NO" ' End If ' Else ' set_data01.Offset(0, 2).value = "New" ' End If '########## 次行 ############# Set set_data01 = set_data01.Offset(1, 0) CNT10 = CNT10 + 1 Application.StatusBar = " 処理件数 > " & CNT10 & " 件" Loop Sheets(mySheetName001).Select Range("A1").Select TEND = Timer '###【メッセージで何秒かかったか】 MsgBox ("おわり。 かかった時間は" & TEND - TSTART & "秒です") '【シートにも結果を保存】 Worksheets("★START1★").Range("E10").value = TEND - TSTART Application.ScreenUpdating = True '###
Discussion
New Comments
No comments yet. Be the first one!