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
'###











ディスカッション
コメント一覧
まだ、コメントがありません