| |
▼ドカ さん：
以下は、もっと極端に差がでます。
TestGen2 これは、先ほどのTestGenより、もっと時間がかかりますががまんしてください。
A列,B列にランダムな値をセットします。
で、そのA列からランダムに５つ、値を取り出して、D列におきます。
Test3,Test4 ともに、このD列の値を持つA列の行のB列の値をE列に転記します。
Sub TestGen2()
Dim i As Long
Dim x As Long
With Sheets("Sheet1")
.Cells.Clear
For i = 1 To 50000
x = Int((50000) * Rnd + 1)
.Cells(i, "A").Value = "A" & Format(i, "0000")
.Cells(i, "B").Value = x
Next
For i = 1 To 5
x = Int((50000) * Rnd + 1)
.Cells(i, "D").Value = .Cells(x, "A").Value
Next
.Columns("A:B").Sort key1:=.Range("B1"), order1:=xlAscending, Header:=xlNo
.Cells.Copy Sheets("Sheet2").Range("A1")
End With
End Sub
Sub Test3()
Dim dic As Object
Dim c As Range
Dim myTime As Double
myTime = Timer '計測開始
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
With .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
For Each c In .Cells
dic(c.Value) = c.Offset(, 1).Value
Next
End With
For Each c In .Range("D1", .Range("D" & .Rows.Count).End(xlUp))
c.Offset(, 1).Value = dic(c.Value)
Next
End With
Application.ScreenUpdating = True
MsgBox Timer - myTime
End Sub
Sub Test4()
Dim c As Range
Dim myTime As Double
Dim myA As Range
Dim x As Long
myTime = Timer '計測開始
Application.ScreenUpdating = False
With Sheets("Sheet1")
With .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
.Resize(, 2).Sort key1:=.Range("A1"), order1:=xlAscending
Set myA = .Columns(1)
End With
For Each c In .Range("D1", .Range("D" & .Rows.Count).End(xlUp))
x = WorksheetFunction.Match(c.Value, myA)
c.Offset(, 1).Value = .Range("B" & x).Value
Next
End With
Application.ScreenUpdating = True
MsgBox Timer - myTime
End Sub
|
|
UO3
- 12/4/3(火) 13:16 -
