| |
行処理で、リソース優先で大きな配列を用意しなくても幾らか速く成る様です？
「日付」の列見出しがA1に在る物とします
Option Explicit
Public Sub Sample()
Dim i As Long
Dim lngRow As Long
Dim lngRowEnd As Long
Dim vntResult As Variant
Dim vntData As Variant
Application.ScreenUpdating = False
With ActiveSheet
'最終行を取得
lngRowEnd = .Cells(Rows.Count, "A").End(xlUp).Row
'書き込み行初期値（2行目から書き込む）
lngRow = 2
'出力用配列の初期値取得（2行目を3列読み込む）
vntResult = .Range(.Cells(lngRow, "A"), .Cells(lngRow, "C")).Value
'データ2行目から最終行+1まで繰り返し
For i = lngRow + 1 To lngRowEnd + 1
'Loopで見ている行、1行分配列に取得
vntData = .Range(.Cells(i, "A"), .Cells(i, "C")).Value
'前の行と項目列の値が同じなら
If vntResult(1, 2) = vntData(1, 2) Then
'もし、読み込んだ行の日付が出力用配列の日付より大きければ
If vntResult(1, 1) < vntData(1, 1) Then
'出力用配列の日付を入れ替える
vntResult(1, 1) = vntData(1, 1)
End If
'もし、読み込んだ行の値段が出力用配列の値段より大きければ
If vntResult(1, 3) < vntData(1, 3) Then
'出力用配列の日付を入れ替える
vntResult(1, 3) = vntData(1, 3)
End If
Else
'出力用配列を書き込み位置に出力
.Range(.Cells(lngRow, "A"), .Cells(lngRow, "C")).Value = vntResult
'書き込み位置を更新
lngRow = lngRow + 1
'出力用配列の中身を読み込んだ行のデータに入れ替え
vntResult = vntData
End If
Next i
'余分なデータを削除
.Range(.Cells(lngRow, "A"), .Cells(lngRowEnd, "C")).Delete
End With
Application.ScreenUpdating = True
MsgBox "処理が完了しました", vbInformation
End Sub
|
|
Hirofumi
- 10/3/31(水) 12:43 -
