借用上一个代码的部份(加字典方法):本机0.016秒 Sub 定向导入3() Dim Sht1 As Worksheet, Sht2 As Worksheet Dim arr, arr1, arr2() Dim Myr1&, Myr2&, h&, k& Set d = CreateObject("Scripting.Dictionary") Set Sht1 = Sheets("数据源") Set Sht2 = Sheets("结果表") t = Timer Application.ScreenUpdating = False Myr1 = Sht1.Range("a65536").End(xlUp).Row Myr2 = Sht2.Range("a65536").End(xlUp).Row arr = Sht1.Range("a2:c" & Myr1) arr1 = Sht2.Range("a2:c" & Myr2) ReDim arr2(1 To Myr2 - 1, 1 To 2) For h = 1 To UBound(arr) d(arr(h, 1)) = arr(h, 3) Next For k = 1 To UBound(arr1) arr2(k, 1) = d(arr1(k, 1)) / 10000 arr2(k, 2) = d(arr1(k, 1)) / 10000 - arr1(k, 3) Next Sht2.Range("d2:e" & Myr2).ClearContents Sht2.Range("d2:e" & Myr2) = arr2 Sheets("操作面").Range("j12") = Timer - t MsgBox Timer - t Application.ScreenUpdating = True End Sub
DLU7Si5W.rar
(119.12 KB, 下载次数: 4)
|