0

我有以下问题要解决。

我有一个 3 列和 29000 行的 excel 表。

a 列是索引号。

b列是一个id号。

c 列是一个数字，它指向 a 列的索引

因此，如果 c 列是 200。我需要转到 a 200 列并将它的列 b id 放在与 c 列索引相同的行上。

这样做的目的是链接这列 c 链接的两个项目的 ID 号。

（我希望我说得通：/）

所以我一直在尝试在 VBA 中编写代码。目前我正在使用嵌套的 for 循环，但正如您可以想象的那样，运行时间很长......

dim i as integer
dim v as integer
dim temp as integer
i = 1
v=1

for i = 1 to 29000
   if cells(i,3).value > 0 then
    temp = cells(i,3).Value
     cells(i,5).value = cells(1,2).value
     for v = 1 to 29000
       if cells(v,1).value = temp and cells(i,5).value <> cells(v,2).value then
            cells(i,6).value  = cells(v,2).value
       end if
      next
    end if
 next

所以它确实可以工作并执行我想要的，但是运行时间太长了。任何想法如何简化程序？

我对 vba 和编程很陌生。

提前致谢

4

1 回答 1

0

未经测试，但编译正常

Sub Test()

Dim dict As Object
Dim i As Long
Dim temp As Long
Dim sht As Worksheet
Dim oldcalc

    Set sht = ActiveSheet
    Set dict = GetMap(sht.Range("A1:B29000"))

    With Application
        .ScreenUpdating = False
        oldcalc = .Calculation
        .Calculation = xlCalculationManual
    End With

    For i = 1 To 29000
       If Cells(i, 3).Value > 0 Then
            temp = Cells(i, 3).Value
            Cells(i, 5).Value = Cells(1, 2).Value
            If dict.exists(temp) Then
               If sht.Cells(i, 5).Value <> dict(temp) Then
                   sht.Cells(i, 6).Value = dict(temp)
               End If
            End If
        End If
     Next

     With Application
        .ScreenUpdating = True
        .Calculation = oldcalc 'restore previous setting
     End With

End Sub

Function GetMap(rng As Range) As Object
    Dim rv As Object, arr, r As Long, numRows As Long
    Set rv = CreateObject("scripting.dictionary") 'EDITED to add Set
    arr = rng.Value
    numRows = UBound(arr, 1)
    For r = 1 To numRows
        If Not rv.exists(arr(r, 1)) Then
            rv.Add arr(r, 1), arr(r, 2)
        End If
    Next r
    Set GetMap = rv
End Function
于 2012-07-20T18:14:42.607 回答