[已解决][求助]请HYY514老师看看，下标越界了。谢谢蓝桥老师和枯禅老师，第二、按索引导入

lhj323323 · 发表于 2010-2-23 07:38

fiy DdA4dpKl.rar (71.14 KB, 下载次数: 1)

wayy · 发表于 2010-2-23 08:13

find方法会调用单元格对象，所以会比较慢。

蓝桥玄霜 · 发表于 2010-2-23 12:01

Sub 定向导入2()
    Dim Sht1 As Worksheet, Sht2 As Worksheet
    Dim arr, arr1, Arr2, t
    Dim Myr1&, Myr2&, h&, k&
    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(arr1)
        For k = 1 To UBound(arr)
            If arr1(h, 1) = arr(k, 1) Then
                Arr2(h, 1) = arr(k, 3) / 10000
                Arr2(h, 2) = arr(k, 3) / 10000 - arr1(h, 3)
                Exit For
            End If
        Next k
    Next h
    Sht2.Range("d2:e" & Myr2).ClearContents
    Sht2.Range("d2:e" & Myr2) = Arr2
    Application.ScreenUpdating = True
    Sheets("操作面").Range("j6") = Timer - t
    MsgBox Timer - t
End Sub
1，声明变量类型用as Long（简写&），适用数据量大的情况；

2，用数组经过优化，只需要0.34秒。

lhj323323 · 发表于 2010-2-23 21:36

谢谢蓝桥老师的帮助，

针对定向导入2，经过您的修改，速度由原来的0。64秒，提升为0。23秒，非常感谢

请问：

导入可否用字典的方法？该怎么写？（不过也不一定是字典，因为我孤陋寡闻，只知道还有个字典，我只想收集和比较不同的方法在速度上的优劣）

附上由您修改的VB。

IOK9kcuZ.rar (119.43 KB, 下载次数: 2)

搁浅2008 · 发表于 2010-2-23 22:00

字典的好处是不需要循环来找到符合的类似于单元格的FIND 但是速度非常快要是没人写我明天试试天晚了睡觉去了

lhj323323 · 发表于 2010-2-24 00:44

谢谢老师了

[此贴子已经被作者于2010-2-24 0:44:08编辑过]

lhj323323 · 发表于 2010-2-25 07:39

求助

lhj323323 · 发表于 2010-2-25 21:05

快沉了，自顶一下

枯禅 · 发表于 2010-2-25 21:35

借用上一个代码的部份(加字典方法)：本机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)

HYY514 · 发表于 2010-2-25 21:48

Sub ff()
Dim Datar As Variant
Dim AsDat As Variant
Dim ReDat() As Double
Dim Dc As Object
Dim i As Long
Dim tmp As Long
Set Dc = CreateObject("scripting.dictionary")
With Sheet3
Datar = .Range(.Range("a2"), .Range("c65536").End(xlUp))
End With
With Sheet2
AsDat = .Range(.Range("a2"), .Range("c65536").End(xlUp))
End With
For i = 1 To UBound(AsDat)
    Dc(AsDat(i, 1)) = i
Next
ReDim ReDat(1 To UBound(Datar), 1 To 2)
For i = 1 To UBound(Datar)
   tmp = Dc(Datar(i, 1))
   'Debug.Print tmp
   ReDat(i, 1) = AsDat(tmp, 3) / 10000
   ReDat(i, 2) = AsDat(tmp, 3) / 10000 - Datar(i, 3)
Next
Sheet3.Range("d2").Resize(UBound(ReDat), 2) = ReDat
MsgBox "ok!"
End Sub

		自动登录	找回密码
密码			注册

[已解决][求助]请HYY514老师看看，下标越界了。谢谢蓝桥老师和枯禅老师，第二、按索引导入

回复：（lhj323323）[求助]第二、求按索引导入的更快、...

回复：（蓝桥玄霜）回复：（lhj323323）[求助]第二、求...

回复：（搁浅2008）字典的好处是不需要循环来找到符合...

回复：（lhj323323）回复：（搁浅2008）字典的好处是 ...

回复：（lhj323323）回复：（lhj323323）回复：（搁浅...

[已解决][求助]请HYY514老师看看，下标越界了。谢谢蓝桥老师和枯禅老师，第二、按索引导入

回复：（lhj323323）[求助]第二、求按索引导入的更快、...

回复：（蓝桥玄霜）回复：（lhj323323）[求助]第二、求...

回复：（搁浅2008）字典的好处是 不需要循环来找到符合...

回复：（lhj323323）回复：（搁浅2008）字典的好处是 ...

回复：（lhj323323）回复：（lhj323323）回复：（搁浅...

回复：（搁浅2008）字典的好处是不需要循环来找到符合...