使用vba excel比较列与其他列

我有以下问题需要解决。使用vba excel比较列与其他列

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

列a是索引号。

列b是一个id号。

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

所以，如果C列200我需要去列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和编程一般。

在此先感谢

来源

2012-07-20 bealor

你能告诉你的结果应该是什么样子的快速样品。我在理解什么在哪里移动有点麻烦。 – 2012-07-20 15:23:10

将所有数据加载到变量数组中（'arr = Range（“A1：F29000”.Value'）），对该数组执行所有操作，然后将其转储回工作表（'Range（“A1：F29000” .Value = arr'）。这会让它更快，但是最好避免使用字典查找循环，尽可能地使用字典查找 – 2012-07-20 15:41:26

因此，C列中的值 - 是您试图在列中找到的数据A？还是行号？还有，你是否需要在VBA中做到这一点，或者是否可以接受一个公式？ – SeanC 2012-07-20 16:31:10

未经检验的，但编译OK

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-20 18:14:42

使用vba excel比较列与其他列

回答

相关问题