| |
Dictionaryの使い方が違うのでは？
Option Explicit
Public Sub Test_1()
Dim MyD As Object
Dim MyVal As Variant, MyVal2 As Variant
Dim MyDate As Date
Dim i As Long
Set MyD = CreateObject("scripting.dictionary")
With Sheets("シート1")
'2行目〜最終行まで繰り返し
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
'KeyとしてA列の値を取得
MyVal = .Cells(i, "A").Value '品番
'日付を取得
MyDate = .Cells(i, "C").Value
'Dictionaryに登録が無かったら
If Not MyD.Exists(MyVal) Then
'品番をKeyとして.code、日付を登録
MyD.Add MyVal, Array(.Cells(i, "B").Value, MyDate)
Else
MyVal2 = MyD(MyVal)
'登録している日付より現在の日付が先なら
If MyVal2(1) > MyDate Then
'Dictionaryの日付を入れ替える
MyVal2(1) = MyDate
'再登録
MyD(MyVal) = MyVal2
End If
End If
Next i
End With
With Sheets("シート2")
'List先頭〜最終まで繰り返し
For i = 4 To .Range("A" & Rows.Count).End(xlUp).Row
'KeyとしてA列の値を取得
MyVal = .Cells(i, "A").Value
'Dictionaryに登録が在ったら
If MyD.Exists(MyVal) Then
.Cells(i, "B").Value = MyD(MyVal)(0) 'code
.Cells(i, "C").Value = MyD(MyVal)(1) '日付
End If
Next i
End With
End Sub
リソースを無視すればもう少し速く成るかも？
Public Sub Test_2()
Dim MyD As Object
Dim MyVal() As Variant, MyVal2() As Variant
Dim i As Long
Dim lngRowEnd As Long
Set MyD = CreateObject("scripting.dictionary")
With Sheets("シート1")
'最終行取得
lngRowEnd = .Range("A" & Rows.Count).End(xlUp).Row
'A、B、C列を配列として取得
MyVal = .Range(.Cells(2, "A"), .Cells(lngRowEnd, "C")).Value
'2行目〜最終行まで繰り返し
For i = 1 To UBound(MyVal, 1)
'Dictionaryに品番登録が無かったら
If Not MyD.Exists(MyVal(i, 1)) Then
'品番をKeyとして.code、日付を登録
MyD.Add MyVal(i, 1), i
Else
'登録している日付より現在の日付が先なら
If MyVal(MyD(MyVal(i, 1)), 1) > MyVal(i, 3) Then
'Dictionaryの行位置を入れ替える
MyD(MyVal(i, 1)) = i
End If
End If
Next i
End With
With Sheets("シート2")
'最終行取得
lngRowEnd = .Range("A" & Rows.Count).End(xlUp).Row
'A、B、C列を配列として取得
MyVal2 = .Range(.Cells(4, "A"), .Cells(lngRowEnd, "C")).Value
'List先頭〜最終まで繰り返し
For i = 1 To UBound(MyVal2, 1)
'Dictionaryに登録が在ったら
If MyD.Exists(MyVal2(i, 1)) Then
MyVal2(i, 2) = MyVal(MyD(MyVal2(i, 1)), 2) 'code
MyVal2(i, 3) = MyVal(MyD(MyVal2(i, 1)), 3) '日付
End If
Next i
'結果を出力
With .Range(.Cells(4, "A"), .Cells(lngRowEnd, "C"))
.ClearContents
.Value = MyVal2
End With
End With
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
