Question

我有以下问题需要解决。

我有一张包含3列和29000行的Excel工作表。

列a是索引号。

列b是一个id号。

列c是指向列a

的索引的数字

因此，如果列c为200.我需要转到列a 200并将其列为b id并将其放在与列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和编程很新。

提前致谢

Answer 1

未经测试，但编译正常

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

使用vba excel将Column与其他列进行比较

1 个答案: